{-# LANGUAGE ImportQualifiedPost #-}

module Apply(applyHints, applyHintFile, applyHintFiles) where

import Control.Applicative
import Data.Monoid
import GHC.All
import Hint.All
import GHC.Util
import Data.Generics.Uniplate.DataOnly
import Idea
import Data.Tuple.Extra
import Data.Either
import Data.List.Extra
import Data.Maybe
import Data.Ord
import Config.Type
import Config.Haskell
import GHC.Types.SrcLoc
import GHC.Hs hiding (comments)
import Language.Haskell.GhclibParserEx.GHC.Hs
import Data.HashSet qualified as Set
import Prelude
import Util
import Timing


-- | Apply hints to a single file, you may have the contents of the file.
applyHintFile :: ParseFlags -> [Setting] -> FilePath -> Maybe String -> IO [Idea]
applyHintFile :: ParseFlags -> [Setting] -> FilePath -> Maybe FilePath -> IO [Idea]
applyHintFile ParseFlags
flags [Setting]
s FilePath
file Maybe FilePath
src = do
    Either Idea ModuleEx
res <- ParseFlags
-> [Setting]
-> FilePath
-> Maybe FilePath
-> IO (Either Idea ModuleEx)
parseModuleApply ParseFlags
flags [Setting]
s FilePath
file Maybe FilePath
src
    [Idea] -> IO [Idea]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Idea] -> IO [Idea]) -> [Idea] -> IO [Idea]
forall a b. (a -> b) -> a -> b
$ case Either Idea ModuleEx
res of
        Left Idea
err -> [Idea
err]
        Right ModuleEx
m -> FilePath -> FilePath -> [Idea] -> [Idea]
forall a. FilePath -> FilePath -> a -> a
timed FilePath
"Execute hints" FilePath
file ([Idea] -> [Idea]
forall a. [a] -> [a]
forceList ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall a b. (a -> b) -> a -> b
$ [Setting] -> [ModuleEx] -> [Idea]
executeHints [Setting]
s [ModuleEx
m])


-- | Apply hints to multiple files, allowing cross-file hints to fire.
applyHintFiles :: ParseFlags -> [Setting] -> [FilePath] -> IO [Idea]
applyHintFiles :: ParseFlags -> [Setting] -> [FilePath] -> IO [Idea]
applyHintFiles ParseFlags
flags [Setting]
s [FilePath]
files = do
    ([Idea]
err, [ModuleEx]
ms) <- [Either Idea ModuleEx] -> ([Idea], [ModuleEx])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either Idea ModuleEx] -> ([Idea], [ModuleEx]))
-> IO [Either Idea ModuleEx] -> IO ([Idea], [ModuleEx])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (Either Idea ModuleEx))
-> [FilePath] -> IO [Either Idea ModuleEx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\FilePath
file -> ParseFlags
-> [Setting]
-> FilePath
-> Maybe FilePath
-> IO (Either Idea ModuleEx)
parseModuleApply ParseFlags
flags [Setting]
s FilePath
file Maybe FilePath
forall a. Maybe a
Nothing) [FilePath]
files
    [Idea] -> IO [Idea]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Idea] -> IO [Idea]) -> [Idea] -> IO [Idea]
forall a b. (a -> b) -> a -> b
$ [Idea]
err [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath -> [Idea] -> [Idea]
forall a. FilePath -> FilePath -> a -> a
timed FilePath
"Execute hints" FilePath
"all modules" ([Idea] -> [Idea]
forall a. [a] -> [a]
forceList ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall a b. (a -> b) -> a -> b
$ [Setting] -> [ModuleEx] -> [Idea]
executeHints [Setting]
s [ModuleEx]
ms)


-- | 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 {- PUBLIC -} :: [Classify] -> Hint -> [ModuleEx] -> [Idea]
applyHints :: [Classify] -> Hint -> [ModuleEx] -> [Idea]
applyHints [Classify]
cs = [Setting] -> Hint -> [ModuleEx] -> [Idea]
applyHintsReal ([Setting] -> Hint -> [ModuleEx] -> [Idea])
-> [Setting] -> Hint -> [ModuleEx] -> [Idea]
forall a b. (a -> b) -> a -> b
$ (Classify -> Setting) -> [Classify] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map Classify -> Setting
SettingClassify [Classify]
cs

applyHintsReal :: [Setting] -> Hint -> [ModuleEx] -> [Idea]
applyHintsReal :: [Setting] -> Hint -> [ModuleEx] -> [Idea]
applyHintsReal [Setting]
settings Hint
hints_ [ModuleEx]
ms = [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Idea]] -> [Idea]) -> [[Idea]] -> [Idea]
forall a b. (a -> b) -> a -> b
$
    [ (Idea -> Idea) -> [Idea] -> [Idea]
forall a b. (a -> b) -> [a] -> [b]
map ([Classify] -> Idea -> Idea
classify [Classify]
classifiers (Idea -> Idea) -> (Idea -> Idea) -> Idea -> Idea
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleEx -> Idea -> Idea
removeRequiresExtensionNotes ModuleEx
m) ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall a b. (a -> b) -> a -> b
$
        [FilePath] -> [Idea] -> [Idea]
order [] (Hint -> [Setting] -> Scope -> ModuleEx -> [Idea]
hintModule Hint
hints [Setting]
settings Scope
nm ModuleEx
m) [Idea] -> [Idea] -> [Idea]
`merge`
        [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath] -> [Idea] -> [Idea]
order (Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList (Maybe FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ LHsDecl GhcPs -> Maybe FilePath
declName LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
d) ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsDecl GhcPs) -> [Idea]
decHints GenLocated SrcSpanAnnA (HsDecl GhcPs)
d | GenLocated SrcSpanAnnA (HsDecl GhcPs)
d <- HsModule GhcPs -> [LHsDecl GhcPs]
forall p. HsModule p -> [LHsDecl p]
hsmodDecls (HsModule GhcPs -> [LHsDecl GhcPs])
-> HsModule GhcPs -> [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs)
-> GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall a b. (a -> b) -> a -> b
$ ModuleEx -> GenLocated SrcSpan (HsModule GhcPs)
ghcModule ModuleEx
m]
    | (Scope
nm,ModuleEx
m) <- [(Scope, ModuleEx)]
mns
    , let classifiers :: [Classify]
classifiers = [Classify]
cls [Classify] -> [Classify] -> [Classify]
forall a. [a] -> [a] -> [a]
++ (AnnDecl GhcPs -> Maybe Classify) -> [AnnDecl GhcPs] -> [Classify]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AnnDecl GhcPs -> Maybe Classify
readPragma (GenLocated SrcSpan (HsModule GhcPs) -> [AnnDecl GhcPs]
forall from to. Biplate from to => from -> [to]
universeBi (ModuleEx -> GenLocated SrcSpan (HsModule GhcPs)
ghcModule ModuleEx
m)) [Classify] -> [Classify] -> [Classify]
forall a. [a] -> [a] -> [a]
++ (LEpaComment -> [Classify]) -> [LEpaComment] -> [Classify]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LEpaComment -> [Classify]
readComment (ModuleEx -> [LEpaComment]
ghcComments ModuleEx
m)
    , Int -> Bool -> Bool
forall a b. a -> b -> b
seq ([Classify] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Classify]
classifiers) Bool
True -- to force any errors from readPragma or readComment
    , let decHints :: LHsDecl GhcPs -> [Idea]
decHints = Hint -> [Setting] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
hintDecl Hint
hints [Setting]
settings Scope
nm ModuleEx
m -- partially apply
    , let order :: [FilePath] -> [Idea] -> [Idea]
order [FilePath]
n = (Idea -> Idea) -> [Idea] -> [Idea]
forall a b. (a -> b) -> [a] -> [b]
map (\Idea
i -> Idea
i{ideaModule = f $ modName (ghcModule m) : ideaModule i, ideaDecl = f $ n ++ ideaDecl i}) ([Idea] -> [Idea]) -> ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Idea -> SrcSpanD) -> [Idea] -> [Idea]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (SrcSpan -> SrcSpanD
SrcSpanD (SrcSpan -> SrcSpanD) -> (Idea -> SrcSpan) -> Idea -> SrcSpanD
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idea -> SrcSpan
ideaSpan)
    , let merge :: [Idea] -> [Idea] -> [Idea]
merge = (Idea -> Idea -> Ordering) -> [Idea] -> [Idea] -> [Idea]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeBy ((Idea -> SrcSpanD) -> Idea -> Idea -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (SrcSpan -> SrcSpanD
SrcSpanD (SrcSpan -> SrcSpanD) -> (Idea -> SrcSpan) -> Idea -> SrcSpanD
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idea -> SrcSpan
ideaSpan))] [[Idea]] -> [[Idea]] -> [[Idea]]
forall a. [a] -> [a] -> [a]
++
    [(Idea -> Idea) -> [Idea] -> [Idea]
forall a b. (a -> b) -> [a] -> [b]
map ([Classify] -> Idea -> Idea
classify [Classify]
cls) (Hint -> [Setting] -> [(Scope, ModuleEx)] -> [Idea]
hintModules Hint
hints [Setting]
settings [(Scope, ModuleEx)]
mns)]
    where
        f :: [FilePath] -> [FilePath]
f = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"")
        cls :: [Classify]
cls = [Classify
x | SettingClassify Classify
x <- [Setting]
settings]
        mns :: [(Scope, ModuleEx)]
mns = (ModuleEx -> (Scope, ModuleEx))
-> [ModuleEx] -> [(Scope, ModuleEx)]
forall a b. (a -> b) -> [a] -> [b]
map (\ModuleEx
x -> (HsModule GhcPs -> Scope
scopeCreate (GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs)
-> GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall a b. (a -> b) -> a -> b
$ ModuleEx -> GenLocated SrcSpan (HsModule GhcPs)
ghcModule ModuleEx
x), ModuleEx
x)) [ModuleEx]
ms
        hints :: Hint
hints = (if [ModuleEx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModuleEx]
ms Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 then Hint -> Hint
noModules else Hint -> Hint
forall a. a -> a
id) Hint
hints_
        noModules :: Hint -> Hint
noModules Hint
h = Hint
h{hintModules = \[Setting]
_ [(Scope, ModuleEx)]
_ -> []} Hint -> Hint -> Hint
forall a. Monoid a => a -> a -> a
`mappend` Hint
forall a. Monoid a => a
mempty{hintModule = \[Setting]
s Scope
a ModuleEx
b -> Hint -> [Setting] -> [(Scope, ModuleEx)] -> [Idea]
hintModules Hint
h [Setting]
s [(Scope
a,ModuleEx
b)]}

-- If the hint has said you RequiresExtension Foo, but Foo is enabled, drop the note
removeRequiresExtensionNotes :: ModuleEx -> Idea -> Idea
removeRequiresExtensionNotes :: ModuleEx -> Idea -> Idea
removeRequiresExtensionNotes ModuleEx
m = \Idea
x -> Idea
x{ideaNote = filter keep $ ideaNote x}
    where
        exts :: HashSet FilePath
exts = [FilePath] -> HashSet FilePath
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList ([FilePath] -> HashSet FilePath) -> [FilePath] -> HashSet FilePath
forall a b. (a -> b) -> a -> b
$ ((LEpaComment, [FilePath]) -> [FilePath])
-> [(LEpaComment, [FilePath])] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (LEpaComment, [FilePath]) -> [FilePath]
forall a b. (a, b) -> b
snd ([(LEpaComment, [FilePath])] -> [FilePath])
-> [(LEpaComment, [FilePath])] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [(LEpaComment, FilePath)] -> [(LEpaComment, [FilePath])]
languagePragmas ([(LEpaComment, FilePath)] -> [(LEpaComment, [FilePath])])
-> [(LEpaComment, FilePath)] -> [(LEpaComment, [FilePath])]
forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [(LEpaComment, FilePath)]
pragmas (EpAnn AnnsModule -> EpAnnComments
forall ann. EpAnn ann -> EpAnnComments
comments (XModulePs -> EpAnn AnnsModule
hsmodAnn (HsModule GhcPs -> XCModule GhcPs
HsModule GhcPs -> XModulePs
forall p. HsModule p -> XCModule p
hsmodExt (HsModule GhcPs -> XModulePs)
-> (ModuleEx -> HsModule GhcPs) -> ModuleEx -> XModulePs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs)
-> (ModuleEx -> GenLocated SrcSpan (HsModule GhcPs))
-> ModuleEx
-> HsModule GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleEx -> GenLocated SrcSpan (HsModule GhcPs)
ghcModule (ModuleEx -> XModulePs) -> ModuleEx -> XModulePs
forall a b. (a -> b) -> a -> b
$ ModuleEx
m)))
        keep :: Note -> Bool
keep (RequiresExtension FilePath
x) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
x FilePath -> HashSet FilePath -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet FilePath
exts
        keep Note
_ = Bool
True

-- | Given a list of settings (a way to classify) and a list of hints, run them over a list of modules.
executeHints :: [Setting] -> [ModuleEx] -> [Idea]
executeHints :: [Setting] -> [ModuleEx] -> [Idea]
executeHints [Setting]
s = [Setting] -> Hint -> [ModuleEx] -> [Idea]
applyHintsReal [Setting]
s ([Setting] -> Hint
allHints [Setting]
s)


-- | Return either an idea (a parse error) or the module. In IO because might call the C pre processor.
parseModuleApply :: ParseFlags -> [Setting] -> FilePath -> Maybe String -> IO (Either Idea ModuleEx)
parseModuleApply :: ParseFlags
-> [Setting]
-> FilePath
-> Maybe FilePath
-> IO (Either Idea ModuleEx)
parseModuleApply ParseFlags
flags [Setting]
s FilePath
file Maybe FilePath
src = do
    Either ParseError ModuleEx
res <- ParseFlags
-> FilePath -> Maybe FilePath -> IO (Either ParseError ModuleEx)
parseModuleEx ([FixityInfo] -> ParseFlags -> ParseFlags
parseFlagsAddFixities [FixityInfo
x | Infix FixityInfo
x <- [Setting]
s] ParseFlags
flags) FilePath
file Maybe FilePath
src
    case Either ParseError ModuleEx
res of
      Right ModuleEx
r -> Either Idea ModuleEx -> IO (Either Idea ModuleEx)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Idea ModuleEx -> IO (Either Idea ModuleEx))
-> Either Idea ModuleEx -> IO (Either Idea ModuleEx)
forall a b. (a -> b) -> a -> b
$ ModuleEx -> Either Idea ModuleEx
forall a b. b -> Either a b
Right ModuleEx
r
      Left (ParseError SrcSpan
sl FilePath
msg FilePath
ctxt) ->
            Either Idea ModuleEx -> IO (Either Idea ModuleEx)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Idea ModuleEx -> IO (Either Idea ModuleEx))
-> Either Idea ModuleEx -> IO (Either Idea ModuleEx)
forall a b. (a -> b) -> a -> b
$ Idea -> Either Idea ModuleEx
forall a b. a -> Either a b
Left (Idea -> Either Idea ModuleEx) -> Idea -> Either Idea ModuleEx
forall a b. (a -> b) -> a -> b
$ [Classify] -> Idea -> Idea
classify [Classify
x | SettingClassify Classify
x <- [Setting]
s] (Idea -> Idea) -> Idea -> Idea
forall a b. (a -> b) -> a -> b
$ Severity
-> FilePath
-> SrcSpan
-> FilePath
-> Maybe FilePath
-> [Note]
-> Idea
rawIdeaN Severity
Error (FilePath -> FilePath
adjustMessage FilePath
msg) SrcSpan
sl FilePath
ctxt Maybe FilePath
forall a. Maybe a
Nothing []
    where

        -- important the message has "Parse error:" as the prefix so "--ignore=Parse error" works
        -- try and tidy up things like "parse error (mismatched brackets)" to not look silly
        adjustMessage :: String -> String
        adjustMessage :: FilePath -> FilePath
adjustMessage FilePath
x = FilePath
"Parse error: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
dropBrackets (
            case FilePath -> FilePath -> Maybe (FilePath, FilePath)
forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
stripInfix FilePath
"parse error " FilePath
x of
              Maybe (FilePath, FilePath)
Nothing -> FilePath
x
              Just (FilePath
prefix, FilePath
_) ->
                FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropPrefix (FilePath
prefix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"parse error ") FilePath
x
          )

        dropBrackets :: FilePath -> FilePath
dropBrackets (Char
'(':FilePath
xs) | Just (FilePath
xs,Char
')') <- FilePath -> Maybe (FilePath, Char)
forall a. [a] -> Maybe ([a], a)
unsnoc FilePath
xs = FilePath
xs
        dropBrackets FilePath
xs = FilePath
xs


-- | Find which hints a list of settings implies.
allHints :: [Setting] -> Hint
allHints :: [Setting] -> Hint
allHints [Setting]
xs = [Hint] -> Hint
forall a. Monoid a => [a] -> a
mconcat ([Hint] -> Hint) -> [Hint] -> Hint
forall a b. (a -> b) -> a -> b
$ [HintRule] -> Hint
hintRules [HintRule
x | SettingMatchExp HintRule
x <- [Setting]
xs] Hint -> [Hint] -> [Hint]
forall a. a -> [a] -> [a]
: (FilePath -> Hint) -> [FilePath] -> [Hint]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Hint
f [FilePath]
builtin
    where builtin :: [FilePath]
builtin = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [if FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"All" then ((FilePath, Hint) -> FilePath) -> [(FilePath, Hint)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Hint) -> FilePath
forall a b. (a, b) -> a
fst [(FilePath, Hint)]
builtinHints else [FilePath
x] | Builtin FilePath
x <- [Setting]
xs]
          f :: FilePath -> Hint
f FilePath
x = Hint -> Maybe Hint -> Hint
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Hint
forall a. HasCallStack => FilePath -> a
error (FilePath -> Hint) -> FilePath -> Hint
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown builtin hints: HLint.Builtin." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x) (Maybe Hint -> Hint) -> Maybe Hint -> Hint
forall a b. (a -> b) -> a -> b
$ FilePath -> [(FilePath, Hint)] -> Maybe Hint
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
x [(FilePath, Hint)]
builtinHints


-- | Given some settings, make sure the severity field of the Idea is correct.
classify :: [Classify] -> Idea -> Idea
classify :: [Classify] -> Idea -> Idea
classify [Classify]
xs Idea
i = let s :: Severity
s = (Severity -> Classify -> Severity)
-> Severity -> [Classify] -> Severity
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Idea -> Severity -> Classify -> Severity
f Idea
i) (Idea -> Severity
ideaSeverity Idea
i) [Classify]
xs in Severity
s Severity -> Idea -> Idea
forall a b. a -> b -> b
`seq` Idea
i{ideaSeverity=s}
    where
        -- figure out if we need to change the severity
        f :: Idea -> Severity -> Classify -> Severity
        f :: Idea -> Severity -> Classify -> Severity
f Idea
i Severity
r Classify
c | Classify -> FilePath
classifyHint Classify
c FilePath -> FilePath -> Bool
~~= Idea -> FilePath
ideaHint Idea
i Bool -> Bool -> Bool
&& Classify -> FilePath
classifyModule Classify
c FilePath -> [FilePath] -> Bool
forall {t :: * -> *}. Foldable t => FilePath -> t FilePath -> Bool
~= Idea -> [FilePath]
ideaModule Idea
i Bool -> Bool -> Bool
&& Classify -> FilePath
classifyDecl Classify
c FilePath -> [FilePath] -> Bool
forall {t :: * -> *}. Foldable t => FilePath -> t FilePath -> Bool
~= Idea -> [FilePath]
ideaDecl Idea
i = Classify -> Severity
classifySeverity Classify
c
                | Bool
otherwise = Severity
r
        FilePath
x ~= :: FilePath -> t FilePath -> Bool
~= t FilePath
y = FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"" Bool -> Bool -> Bool
|| (FilePath -> Bool) -> t FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
wildcardMatch FilePath
x) t FilePath
y
        FilePath
x  ~~= :: FilePath -> FilePath -> Bool
~~= FilePath
y = FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"" Bool -> Bool -> Bool
|| FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
y Bool -> Bool -> Bool
|| ((FilePath
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":") FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
y)