{-# 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]
-- @
module Language.Haskell.HLint3(
    hlint, applyHints,
    -- * Idea data type
    Idea(..), Severity(..), Note(..),
    -- * Settings
    Classify(..),
    getHLintDataDir, autoSettings, argsSettings,
    findSettings, readSettingsFile,
    -- * Hints
    HintBuiltin(..), HintRule(..),
    Hint(..), resolveHints,
    -- * Scopes
    Scope, scopeCreate, scopeMatch, scopeMove,
    -- * Haskell-src-exts
    parseModuleEx, defaultParseFlags, parseFlagsAddFixities, ParseError(..), ParseFlags(..), CppFlags(..)
    ) where

import Config.Type
import Config.Read
import Idea
import Apply
import HLint
import HSE.All
import Hint.All
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 :: IO FilePath
getHLintDataDir = IO FilePath
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 :: IO (ParseFlags, [Classify], Hint)
autoSettings = do
    (fixities :: [Fixity]
fixities, classify :: [Classify]
classify, hints :: [Either HintBuiltin HintRule]
hints) <- (FilePath -> IO (FilePath, Maybe FilePath))
-> Maybe FilePath
-> IO ([Fixity], [Classify], [Either HintBuiltin HintRule])
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, [Either HintBuiltin HintRule] -> Hint
resolveHints [Either HintBuiltin HintRule]
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 :: [FilePath] -> IO (ParseFlags, [Classify], Hint)
argsSettings args :: [FilePath]
args = do
    Cmd
cmd <- [FilePath] -> IO Cmd
getCmd [FilePath]
args
    case Cmd
cmd of
        CmdMain{..} -> do
            -- FIXME: Two things that could be supported (but aren't) are 'cmdGivenHints' and 'cmdWithHints'.
            (_,settings :: [Setting]
settings) <- [FilePath] -> Cmd -> IO (Cmd, [Setting])
readAllSettings [FilePath]
args Cmd
cmd
            let (fixities :: [Fixity]
fixities, classify :: [Classify]
classify, hints :: [Either HintBuiltin HintRule]
hints) = [Setting] -> ([Fixity], [Classify], [Either HintBuiltin HintRule])
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, [Either HintBuiltin HintRule] -> Hint
resolveHints [Either HintBuiltin HintRule]
hints)
        _ -> FilePath -> IO (ParseFlags, [Classify], Hint)
forall a. HasCallStack => FilePath -> a
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 :: 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)


-- | 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], [Either HintBuiltin HintRule])
findSettings :: (FilePath -> IO (FilePath, Maybe FilePath))
-> Maybe FilePath
-> IO ([Fixity], [Classify], [Either HintBuiltin HintRule])
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], [Either HintBuiltin HintRule])
splitSettings ([Setting]
 -> ([Fixity], [Classify], [Either HintBuiltin HintRule]))
-> IO [Setting]
-> IO ([Fixity], [Classify], [Either HintBuiltin HintRule])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(FilePath, Maybe FilePath)] -> IO [Setting]
readFilesConfig [(FilePath
file,Maybe FilePath
contents)]

-- | Split a list of 'Setting' for separate use in parsing and hint resolution
splitSettings :: [Setting] -> ([Fixity], [Classify], [Either HintBuiltin HintRule])
splitSettings :: [Setting] -> ([Fixity], [Classify], [Either HintBuiltin HintRule])
splitSettings xs :: [Setting]
xs =
    ([Fixity
x | Infix x :: Fixity
x <- [Setting]
xs]
    ,[Classify
x | SettingClassify x :: Classify
x <- [Setting]
xs]
    ,[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])

-- | Snippet from the documentation, if this changes, update the documentation
_docs :: IO ()
_docs :: IO ()
_docs = do
    (flags :: ParseFlags
flags, classify :: [Classify]
classify, hint :: Hint
hint) <- IO (ParseFlags, [Classify], Hint)
autoSettings
    Right m :: (Module SrcSpanInfo, [Comment])
m <- ParseFlags
-> FilePath
-> Maybe FilePath
-> IO (Either ParseError (Module SrcSpanInfo, [Comment]))
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 -> [(Module SrcSpanInfo, [Comment])] -> [Idea]
applyHints [Classify]
classify Hint
hint [(Module SrcSpanInfo, [Comment])
m]