{-# LANGUAGE PatternGuards, RecordWildCards #-}
module Language.Haskell.HLint(
hlint, applyHints,
Idea(..), Severity(..), Note(..), unpackSrcSpan, showIdeaANSI,
Classify(..),
getHLintDataDir, autoSettings, argsSettings,
findSettings, readSettingsFile,
Hint,
ModuleEx, parseModuleEx, createModuleEx, createModuleExWithFixities, ParseError(..),
defaultParseFlags,
ParseFlags(..), CppFlags(..), FixityInfo,
parseFlagsAddFixities,
) where
import Config.Type
import Config.Read
import Idea
import qualified Apply as H
import HLint
import Fixity
import GHC.Data.FastString ( unpackFS )
import GHC.All
import Hint.All hiding (resolveHints)
import qualified Hint.All as H
import GHC.Types.SrcLoc
import CmdLine
import Paths_hlint
import Data.List.Extra
import Data.Maybe
import System.FilePath
import Data.Functor
import Prelude
import qualified Hint.Restrict as Restrict
getHLintDataDir :: IO FilePath
getHLintDataDir :: IO String
getHLintDataDir = IO String
getDataDir
autoSettings :: IO (ParseFlags, [Classify], Hint)
autoSettings :: IO (ParseFlags, [Classify], Hint)
autoSettings = do
([FixityInfo]
fixities, [Classify]
classify, Hint
hints) <- (String -> IO (String, Maybe String))
-> Maybe String -> IO ([FixityInfo], [Classify], Hint)
findSettings (Maybe String -> String -> IO (String, Maybe String)
readSettingsFile forall a. Maybe a
Nothing) forall a. Maybe a
Nothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FixityInfo] -> ParseFlags -> ParseFlags
parseFlagsAddFixities [FixityInfo]
fixities ParseFlags
defaultParseFlags, [Classify]
classify, Hint
hints)
argsSettings :: [String] -> IO (ParseFlags, [Classify], Hint)
argsSettings :: [String] -> IO (ParseFlags, [Classify], Hint)
argsSettings [String]
args = do
cmd :: Cmd
cmd@CmdMain{Bool
Int
String
[String]
[Severity]
ColorMode
cmdTest :: Cmd -> Bool
cmdGenerateExhaustiveConf :: Cmd -> [Severity]
cmdGenerateJsonSummary :: Cmd -> [String]
cmdGenerateMdSummary :: Cmd -> [String]
cmdIgnoreGlob :: Cmd -> [String]
cmdWithRefactor :: Cmd -> String
cmdRefactorOptions :: Cmd -> String
cmdRefactor :: Cmd -> Bool
cmdSerialise :: Cmd -> Bool
cmdTiming :: Cmd -> Bool
cmdNoExitCode :: Cmd -> Bool
cmdOnly :: Cmd -> [String]
cmdNoSummary :: Cmd -> Bool
cmdCC :: Cmd -> Bool
cmdJson :: Cmd -> Bool
cmdCppAnsi :: Cmd -> Bool
cmdCppSimple :: Cmd -> Bool
cmdCppFile :: Cmd -> [String]
cmdCppInclude :: Cmd -> [String]
cmdCppDefine :: Cmd -> [String]
cmdPath :: Cmd -> [String]
cmdDefault :: Cmd -> Bool
cmdDataDir :: Cmd -> String
cmdFindHints :: Cmd -> [String]
cmdCross :: Cmd -> Bool
cmdLanguage :: Cmd -> [String]
cmdExtension :: Cmd -> [String]
cmdShowAll :: Cmd -> Bool
cmdIgnore :: Cmd -> [String]
cmdThreads :: Cmd -> Int
cmdColor :: Cmd -> ColorMode
cmdGit :: Cmd -> Bool
cmdWithGroups :: Cmd -> [String]
cmdGivenHints :: Cmd -> [String]
cmdReports :: Cmd -> [String]
cmdFiles :: Cmd -> [String]
cmdTest :: Bool
cmdGenerateExhaustiveConf :: [Severity]
cmdGenerateJsonSummary :: [String]
cmdGenerateMdSummary :: [String]
cmdIgnoreGlob :: [String]
cmdWithRefactor :: String
cmdRefactorOptions :: String
cmdRefactor :: Bool
cmdSerialise :: Bool
cmdTiming :: Bool
cmdNoExitCode :: Bool
cmdOnly :: [String]
cmdNoSummary :: Bool
cmdCC :: Bool
cmdJson :: Bool
cmdCppAnsi :: Bool
cmdCppSimple :: Bool
cmdCppFile :: [String]
cmdCppInclude :: [String]
cmdCppDefine :: [String]
cmdPath :: [String]
cmdDefault :: Bool
cmdDataDir :: String
cmdFindHints :: [String]
cmdCross :: Bool
cmdLanguage :: [String]
cmdExtension :: [String]
cmdShowAll :: Bool
cmdIgnore :: [String]
cmdThreads :: Int
cmdColor :: ColorMode
cmdGit :: Bool
cmdWithGroups :: [String]
cmdGivenHints :: [String]
cmdReports :: [String]
cmdFiles :: [String]
..} <- [String] -> IO Cmd
getCmd [String]
args
(Cmd
_,[Setting]
settings) <- [String] -> Cmd -> IO (Cmd, [Setting])
readAllSettings [String]
args Cmd
cmd
let ([FixityInfo]
fixities, [Classify]
classify, Hint
hints) = [Setting] -> ([FixityInfo], [Classify], Hint)
splitSettings [Setting]
settings
let flags :: ParseFlags
flags = (Maybe Language, ([Extension], [Extension]))
-> ParseFlags -> ParseFlags
parseFlagsSetLanguage (Cmd -> (Maybe Language, ([Extension], [Extension]))
cmdExtensions Cmd
cmd) forall a b. (a -> b) -> a -> b
$ [FixityInfo] -> ParseFlags -> ParseFlags
parseFlagsAddFixities [FixityInfo]
fixities forall a b. (a -> b) -> a -> b
$
ParseFlags
defaultParseFlags{cppFlags :: CppFlags
cppFlags = Cmd -> CppFlags
cmdCpp Cmd
cmd}
let ignore :: [Classify]
ignore = [Severity -> String -> String -> String -> Classify
Classify Severity
Ignore String
x String
"" String
"" | String
x <- [String]
cmdIgnore]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseFlags
flags, [Classify]
classify forall a. [a] -> [a] -> [a]
++ [Classify]
ignore, Hint
hints)
readSettingsFile :: Maybe FilePath -> String -> IO (FilePath, Maybe String)
readSettingsFile :: Maybe String -> String -> IO (String, Maybe String)
readSettingsFile Maybe String
dir String
x
| String -> String
takeExtension String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".yml",String
".yaml"] = do
String
dir <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getHLintDataDir forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
dir
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
dir String -> String -> String
</> String
x, forall a. Maybe a
Nothing)
| Just String
x <- String
"HLint." forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` String
x = do
String
dir <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getHLintDataDir forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
dir
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
dir String -> String -> String
</> String
x String -> String -> String
<.> String
"hs", forall a. Maybe a
Nothing)
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
x String -> String -> String
<.> String
"hs", forall a. Maybe a
Nothing)
findSettings :: (String -> IO (FilePath, Maybe String)) -> Maybe String -> IO ([FixityInfo], [Classify], Hint)
findSettings :: (String -> IO (String, Maybe String))
-> Maybe String -> IO ([FixityInfo], [Classify], Hint)
findSettings String -> IO (String, Maybe String)
load Maybe String
start = do
(String
file,Maybe String
contents) <- String -> IO (String, Maybe String)
load forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe String
"hlint.yaml" Maybe String
start
[Setting] -> ([FixityInfo], [Classify], Hint)
splitSettings forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, Maybe String)] -> IO [Setting]
readFilesConfig [(String
file,Maybe String
contents)]
splitSettings :: [Setting] -> ([FixityInfo], [Classify], Hint)
splitSettings :: [Setting] -> ([FixityInfo], [Classify], Hint)
splitSettings [Setting]
xs =
([FixityInfo
x | Infix FixityInfo
x <- [Setting]
xs]
,[Classify
x | SettingClassify Classify
x <- [Setting]
xs]
,[Either HintBuiltin HintRule] -> Hint
H.resolveHints ([forall a b. b -> Either a b
Right HintRule
x | SettingMatchExp HintRule
x <- [Setting]
xs] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left forall a. (Enum a, Bounded a) => [a]
enumerate)
forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => a
mempty { hintModule :: [Setting] -> Scope -> ModuleEx -> [Idea]
hintModule = [Setting] -> Scope -> ModuleEx -> [Idea]
Restrict.restrictHint forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Setting]
xsforall a. [a] -> [a] -> [a]
++)}
)
applyHints :: [Classify] -> Hint -> [ModuleEx] -> [Idea]
applyHints :: [Classify] -> Hint -> [ModuleEx] -> [Idea]
applyHints = [Classify] -> Hint -> [ModuleEx] -> [Idea]
H.applyHints
_docs :: IO ()
_docs :: IO ()
_docs = do
(ParseFlags
flags, [Classify]
classify, Hint
hint) <- IO (ParseFlags, [Classify], Hint)
autoSettings
Right ModuleEx
m <- ParseFlags
-> String -> Maybe String -> IO (Either ParseError ModuleEx)
parseModuleEx ParseFlags
flags String
"MyFile.hs" forall a. Maybe a
Nothing
forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ [Classify] -> Hint -> [ModuleEx] -> [Idea]
applyHints [Classify]
classify Hint
hint [ModuleEx
m]
unpackSrcSpan :: SrcSpan -> Maybe (FilePath, (Int, Int), (Int, Int))
unpackSrcSpan :: SrcSpan -> Maybe (String, (Int, Int), (Int, Int))
unpackSrcSpan (RealSrcSpan RealSrcSpan
x Maybe BufSpan
_) = forall a. a -> Maybe a
Just
(FastString -> String
unpackFS forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
x
,(RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
x, RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
x)
,(RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
x, RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
x))
unpackSrcSpan SrcSpan
_ = forall a. Maybe a
Nothing