{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE PatternGuards, RecordWildCards #-}

-- |  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.HLint(
    -- * Generate hints
    hlint, applyHints,
    -- * Idea data type
    Idea(..), Severity(..), Note(..), unpackSrcSpan, showIdeaANSI,
    -- * Settings
    Classify(..),
    getHLintDataDir, autoSettings, argsSettings,
    findSettings, readSettingsFile,
    -- * Hints
    Hint,
    -- * Modules
    ModuleEx, parseModuleEx, createModuleEx, createModuleExWithFixities, ParseError(..),
    -- * Parse flags
    defaultParseFlags,
    ParseFlags(..), CppFlags(..), FixityInfo,
    parseFlagsAddFixities,
    ) where

import Config.Type
import Config.Read
import Idea
import Apply qualified as H
import HLint
import Fixity
import GHC.Data.FastString ( unpackFS )
import GHC.All
import Hint.All hiding (resolveHints)
import Hint.All qualified 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 Hint.Restrict qualified as Restrict


-- | Get the Cabal configured data directory of HLint.
getHLintDataDir :: IO FilePath
getHLintDataDir :: IO String
getHLintDataDir = IO String
getDataDir


-- | The function produces a tuple containing '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 :: 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 Maybe String
forall a. Maybe a
Nothing) Maybe String
forall a. Maybe a
Nothing
    (ParseFlags, [Classify], Hint) -> IO (ParseFlags, [Classify], Hint)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FixityInfo] -> ParseFlags -> ParseFlags
parseFlagsAddFixities [FixityInfo]
fixities ParseFlags
defaultParseFlags, [Classify]
classify, Hint
hints)


-- | 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 :: [String] -> IO (ParseFlags, [Classify], Hint)
argsSettings [String]
args = do
    cmd :: Cmd
cmd@CmdMain{Bool
Int
String
[String]
[Severity]
ColorMode
cmdFiles :: [String]
cmdReports :: [String]
cmdGivenHints :: [String]
cmdWithGroups :: [String]
cmdGit :: Bool
cmdColor :: ColorMode
cmdThreads :: Int
cmdIgnore :: [String]
cmdShowAll :: Bool
cmdIgnoreSuggestions :: Bool
cmdExtension :: [String]
cmdLanguage :: [String]
cmdCross :: Bool
cmdFindHints :: [String]
cmdDataDir :: String
cmdDefault :: Bool
cmdPath :: [String]
cmdCppDefine :: [String]
cmdCppInclude :: [String]
cmdCppFile :: [String]
cmdCppSimple :: Bool
cmdCppAnsi :: Bool
cmdJson :: Bool
cmdCC :: Bool
cmdSARIF :: Bool
cmdNoSummary :: Bool
cmdOnly :: [String]
cmdNoExitCode :: Bool
cmdTiming :: Bool
cmdSerialise :: Bool
cmdRefactor :: Bool
cmdRefactorOptions :: String
cmdWithRefactor :: String
cmdIgnoreGlob :: [String]
cmdGenerateMdSummary :: [String]
cmdGenerateJsonSummary :: [String]
cmdGenerateExhaustiveConf :: [Severity]
cmdTest :: Bool
cmdFiles :: Cmd -> [String]
cmdReports :: Cmd -> [String]
cmdGivenHints :: Cmd -> [String]
cmdWithGroups :: Cmd -> [String]
cmdGit :: Cmd -> Bool
cmdColor :: Cmd -> ColorMode
cmdThreads :: Cmd -> Int
cmdIgnore :: Cmd -> [String]
cmdShowAll :: Cmd -> Bool
cmdIgnoreSuggestions :: Cmd -> Bool
cmdExtension :: Cmd -> [String]
cmdLanguage :: Cmd -> [String]
cmdCross :: Cmd -> Bool
cmdFindHints :: Cmd -> [String]
cmdDataDir :: Cmd -> String
cmdDefault :: Cmd -> Bool
cmdPath :: Cmd -> [String]
cmdCppDefine :: Cmd -> [String]
cmdCppInclude :: Cmd -> [String]
cmdCppFile :: Cmd -> [String]
cmdCppSimple :: Cmd -> Bool
cmdCppAnsi :: Cmd -> Bool
cmdJson :: Cmd -> Bool
cmdCC :: Cmd -> Bool
cmdSARIF :: Cmd -> Bool
cmdNoSummary :: Cmd -> Bool
cmdOnly :: Cmd -> [String]
cmdNoExitCode :: Cmd -> Bool
cmdTiming :: Cmd -> Bool
cmdSerialise :: Cmd -> Bool
cmdRefactor :: Cmd -> Bool
cmdRefactorOptions :: Cmd -> String
cmdWithRefactor :: Cmd -> String
cmdIgnoreGlob :: Cmd -> [String]
cmdGenerateMdSummary :: Cmd -> [String]
cmdGenerateJsonSummary :: Cmd -> [String]
cmdGenerateExhaustiveConf :: Cmd -> [Severity]
cmdTest :: Cmd -> Bool
..} <- [String] -> IO Cmd
getCmd [String]
args
    -- FIXME: One thing that could be supported (but isn't) is 'cmdGivenHints'
    (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) (ParseFlags -> ParseFlags) -> ParseFlags -> ParseFlags
forall a b. (a -> b) -> a -> b
$ [FixityInfo] -> ParseFlags -> ParseFlags
parseFlagsAddFixities [FixityInfo]
fixities (ParseFlags -> ParseFlags) -> ParseFlags -> ParseFlags
forall a b. (a -> b) -> a -> b
$
                ParseFlags
defaultParseFlags{cppFlags = cmdCpp cmd}
    let ignore :: [Classify]
ignore = [Severity -> String -> String -> String -> Classify
Classify Severity
Ignore String
x String
"" String
"" | String
x <- [String]
cmdIgnore]
    (ParseFlags, [Classify], Hint) -> IO (ParseFlags, [Classify], Hint)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseFlags
flags, [Classify]
classify [Classify] -> [Classify] -> [Classify]
forall a. [a] -> [a] -> [a]
++ [Classify]
ignore, Hint
hints)


-- | 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 :: Maybe String -> String -> IO (String, Maybe String)
readSettingsFile Maybe String
dir String
x
    | String -> String
takeExtension String
x String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".yml",String
".yaml"] = do
        String
dir <- IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getHLintDataDir String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
dir
        (String, Maybe String) -> IO (String, Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
dir String -> String -> String
</> String
x, Maybe String
forall a. Maybe a
Nothing)
    | Just String
x <- String
"HLint." String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` String
x = do
        String
dir <- IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getHLintDataDir String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
dir
        (String, Maybe String) -> IO (String, Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
dir String -> String -> String
</> String
x String -> String -> String
<.> String
"hs", Maybe String
forall a. Maybe a
Nothing)
    | Bool
otherwise = (String, Maybe String) -> IO (String, Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
x String -> String -> String
<.> String
"hs", Maybe String
forall a. Maybe a
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 ([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 (String -> IO (String, Maybe String))
-> String -> IO (String, Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"hlint.yaml" Maybe String
start
    [Setting] -> ([FixityInfo], [Classify], Hint)
splitSettings ([Setting] -> ([FixityInfo], [Classify], Hint))
-> IO [Setting] -> IO ([FixityInfo], [Classify], Hint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, Maybe String)] -> IO [Setting]
readFilesConfig [(String
file,Maybe String
contents)]

-- | Split a list of 'Setting' for separate use in parsing and hint resolution
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 ([HintRule -> Either HintBuiltin HintRule
forall a b. b -> Either a b
Right HintRule
x | SettingMatchExp 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. (Enum a, Bounded a) => [a]
enumerate)
    Hint -> Hint -> Hint
forall a. Semigroup a => a -> a -> a
<> Hint
forall a. Monoid a => a
mempty { hintModule = Restrict.restrictHint . (xs++)}
    )


-- | 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 :: [Classify] -> Hint -> [ModuleEx] -> [Idea]
applyHints = [Classify] -> Hint -> [ModuleEx] -> [Idea]
H.applyHints

-- | Snippet from the documentation, if this changes, update the documentation
_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" Maybe String
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]

-- | Unpack a 'SrcSpan' value. Useful to allow using the 'Idea' information without
--   adding a dependency on @ghc@ or @ghc-lib-parser@. Unpacking gives:
--
-- > (filename, (startLine, startCol), (endLine, endCol))
--
--   Following the GHC API, end column is the column /after/ the end of the error.
--   Lines and columns are 1-based. Returns 'Nothing' if there is no helpful location information.
unpackSrcSpan :: SrcSpan -> Maybe (FilePath, (Int, Int), (Int, Int))
unpackSrcSpan :: SrcSpan -> Maybe (String, (Int, Int), (Int, Int))
unpackSrcSpan (RealSrcSpan RealSrcSpan
x Maybe BufSpan
_) = (String, (Int, Int), (Int, Int))
-> Maybe (String, (Int, Int), (Int, Int))
forall a. a -> Maybe a
Just
    (FastString -> String
unpackFS (FastString -> String) -> FastString -> String
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
_ = Maybe (String, (Int, Int), (Int, Int))
forall a. Maybe a
Nothing