{-# LANGUAGE PatternGuards, RecordWildCards #-}
module Language.Haskell.HLint4(
hlint, applyHints,
Idea(..), Severity(..), Note(..),
Classify(..),
getHLintDataDir, autoSettings, argsSettings,
findSettings, readSettingsFile,
Hint, resolveHints,
ModuleEx, parseModuleEx, createModuleEx, 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 qualified ApiAnnotation as GHC
import qualified HsSyn as GHC
import SrcLoc
import CmdLine
import Paths_hlint
import qualified Language.Haskell.GhclibParserEx.Fixity as GhclibParserEx
import Data.List.Extra
import Data.Maybe
import System.FilePath
import Data.Functor
import Prelude
getHLintDataDir :: IO FilePath
getHLintDataDir :: IO FilePath
getHLintDataDir = IO FilePath
getDataDir
autoSettings :: IO (ParseFlags, [Classify], Hint)
autoSettings :: IO (ParseFlags, [Classify], Hint)
autoSettings = do
(fixities :: [Fixity]
fixities, classify :: [Classify]
classify, hints :: Hint
hints) <- (FilePath -> IO (FilePath, Maybe FilePath))
-> Maybe FilePath -> IO ([Fixity], [Classify], Hint)
findSettings (Maybe FilePath -> FilePath -> IO (FilePath, Maybe FilePath)
readSettingsFile Maybe FilePath
forall a. Maybe a
Nothing) Maybe FilePath
forall a. Maybe a
Nothing
(ParseFlags, [Classify], Hint) -> IO (ParseFlags, [Classify], Hint)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Fixity] -> ParseFlags -> ParseFlags
parseFlagsAddFixities [Fixity]
fixities ParseFlags
defaultParseFlags, [Classify]
classify, Hint
hints)
resolveHints :: Hint -> Hint
resolveHints :: Hint -> Hint
resolveHints = Hint -> Hint
forall a. a -> a
id
argsSettings :: [String] -> IO (ParseFlags, [Classify], Hint)
argsSettings :: [FilePath] -> IO (ParseFlags, [Classify], Hint)
argsSettings args :: [FilePath]
args = do
Cmd
cmd <- [FilePath] -> IO Cmd
getCmd [FilePath]
args
case Cmd
cmd of
CmdMain{..} -> do
(_,settings :: [Setting]
settings) <- [FilePath] -> Cmd -> IO (Cmd, [Setting])
readAllSettings [FilePath]
args Cmd
cmd
let (fixities :: [Fixity]
fixities, classify :: [Classify]
classify, hints :: Hint
hints) = [Setting] -> ([Fixity], [Classify], Hint)
splitSettings [Setting]
settings
let flags :: ParseFlags
flags = (Language, [Extension]) -> ParseFlags -> ParseFlags
parseFlagsSetLanguage (Cmd -> (Language, [Extension])
cmdExtensions Cmd
cmd) (ParseFlags -> ParseFlags) -> ParseFlags -> ParseFlags
forall a b. (a -> b) -> a -> b
$ [Fixity] -> ParseFlags -> ParseFlags
parseFlagsAddFixities [Fixity]
fixities (ParseFlags -> ParseFlags) -> ParseFlags -> ParseFlags
forall a b. (a -> b) -> a -> b
$
ParseFlags
defaultParseFlags{cppFlags :: CppFlags
cppFlags = Cmd -> CppFlags
cmdCpp Cmd
cmd}
let ignore :: [Classify]
ignore = [Severity -> FilePath -> FilePath -> FilePath -> Classify
Classify Severity
Ignore FilePath
x "" "" | FilePath
x <- [FilePath]
cmdIgnore]
(ParseFlags, [Classify], Hint) -> IO (ParseFlags, [Classify], Hint)
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseFlags
flags, [Classify]
classify [Classify] -> [Classify] -> [Classify]
forall a. [a] -> [a] -> [a]
++ [Classify]
ignore, Hint
hints)
_ -> FilePath -> IO (ParseFlags, [Classify], Hint)
forall a. HasCallStack => FilePath -> a
error "Can only invoke autoSettingsArgs with the root process"
readSettingsFile :: Maybe FilePath -> String -> IO (FilePath, Maybe String)
readSettingsFile :: Maybe FilePath -> FilePath -> IO (FilePath, Maybe FilePath)
readSettingsFile dir :: Maybe FilePath
dir x :: FilePath
x
| FilePath -> FilePath
takeExtension FilePath
x FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [".yml",".yaml"] = do
FilePath
dir <- IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO FilePath
getHLintDataDir FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
dir
(FilePath, Maybe FilePath) -> IO (FilePath, Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
x, Maybe FilePath
forall a. Maybe a
Nothing)
| Just x :: FilePath
x <- "HLint." FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` FilePath
x = do
FilePath
dir <- IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO FilePath
getHLintDataDir FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
dir
(FilePath, Maybe FilePath) -> IO (FilePath, Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
x FilePath -> FilePath -> FilePath
<.> "hs", Maybe FilePath
forall a. Maybe a
Nothing)
| Bool
otherwise = (FilePath, Maybe FilePath) -> IO (FilePath, Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
x FilePath -> FilePath -> FilePath
<.> "hs", Maybe FilePath
forall a. Maybe a
Nothing)
findSettings :: (String -> IO (FilePath, Maybe String)) -> Maybe String -> IO ([Fixity], [Classify], Hint)
findSettings :: (FilePath -> IO (FilePath, Maybe FilePath))
-> Maybe FilePath -> IO ([Fixity], [Classify], Hint)
findSettings load :: FilePath -> IO (FilePath, Maybe FilePath)
load start :: Maybe FilePath
start = do
(file :: FilePath
file,contents :: Maybe FilePath
contents) <- FilePath -> IO (FilePath, Maybe FilePath)
load (FilePath -> IO (FilePath, Maybe FilePath))
-> FilePath -> IO (FilePath, Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe "hlint.yaml" Maybe FilePath
start
[Setting] -> ([Fixity], [Classify], Hint)
splitSettings ([Setting] -> ([Fixity], [Classify], Hint))
-> IO [Setting] -> IO ([Fixity], [Classify], Hint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(FilePath, Maybe FilePath)] -> IO [Setting]
readFilesConfig [(FilePath
file,Maybe FilePath
contents)]
splitSettings :: [Setting] -> ([Fixity], [Classify], Hint)
splitSettings :: [Setting] -> ([Fixity], [Classify], Hint)
splitSettings xs :: [Setting]
xs =
([Fixity
x | Infix x :: Fixity
x <- [Setting]
xs]
,[Classify
x | SettingClassify x :: Classify
x <- [Setting]
xs]
,[Either HintBuiltin HintRule] -> Hint
H.resolveHints ([Either HintBuiltin HintRule] -> Hint)
-> [Either HintBuiltin HintRule] -> Hint
forall a b. (a -> b) -> a -> b
$ [HintRule -> Either HintBuiltin HintRule
forall a b. b -> Either a b
Right HintRule
x | SettingMatchExp x :: HintRule
x <- [Setting]
xs] [Either HintBuiltin HintRule]
-> [Either HintBuiltin HintRule] -> [Either HintBuiltin HintRule]
forall a. [a] -> [a] -> [a]
++ (HintBuiltin -> Either HintBuiltin HintRule)
-> [HintBuiltin] -> [Either HintBuiltin HintRule]
forall a b. (a -> b) -> [a] -> [b]
map HintBuiltin -> Either HintBuiltin HintRule
forall a b. a -> Either a b
Left [HintBuiltin
forall a. Bounded a => a
minBound..HintBuiltin
forall a. Bounded a => a
maxBound])
applyHints :: [Classify] -> Hint -> [ModuleEx] -> [Idea]
applyHints :: [Classify] -> Hint -> [ModuleEx] -> [Idea]
applyHints = [Classify] -> Hint -> [ModuleEx] -> [Idea]
H.applyHints
_docs :: IO ()
_docs :: IO ()
_docs = do
(flags :: ParseFlags
flags, classify :: [Classify]
classify, hint :: Hint
hint) <- IO (ParseFlags, [Classify], Hint)
autoSettings
Right m :: ModuleEx
m <- ParseFlags
-> FilePath -> Maybe FilePath -> IO (Either ParseError ModuleEx)
parseModuleEx ParseFlags
flags "MyFile.hs" Maybe FilePath
forall a. Maybe a
Nothing
[Idea] -> IO ()
forall a. Show a => a -> IO ()
print ([Idea] -> IO ()) -> [Idea] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Classify] -> Hint -> [ModuleEx] -> [Idea]
applyHints [Classify]
classify Hint
hint [ModuleEx
m]
createModuleEx:: GHC.ApiAnns -> Located (GHC.HsModule GHC.GhcPs) -> ModuleEx
createModuleEx :: ApiAnns -> Located (HsModule GhcPs) -> ModuleEx
createModuleEx anns :: ApiAnns
anns ast :: Located (HsModule GhcPs)
ast =
Module SrcSpanInfo
-> [Comment] -> Located (HsModule GhcPs) -> ApiAnns -> ModuleEx
ModuleEx Module SrcSpanInfo
empty [] ([(FilePath, Fixity)]
-> Located (HsModule GhcPs) -> Located (HsModule GhcPs)
forall a. Data a => [(FilePath, Fixity)] -> a -> a
GhclibParserEx.applyFixities [] Located (HsModule GhcPs)
ast) ApiAnns
anns
where empty :: Module SrcSpanInfo
empty = SrcSpanInfo
-> Maybe (ModuleHead SrcSpanInfo)
-> [ModulePragma SrcSpanInfo]
-> [ImportDecl SrcSpanInfo]
-> [Decl SrcSpanInfo]
-> Module SrcSpanInfo
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
Module SrcSpanInfo
an Maybe (ModuleHead SrcSpanInfo)
forall a. Maybe a
Nothing [] [] []