module Apply(applyHints, applyHintFile, applyHintFiles) where

import Control.Applicative
import Data.Monoid
import HSE.All
import Hint.All
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 qualified Data.HashSet as Set
import Prelude


-- | 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 flags :: ParseFlags
flags s :: [Setting]
s file :: FilePath
file src :: Maybe FilePath
src = do
    Either Idea (Module_, [Comment])
res <- ParseFlags
-> [Setting]
-> FilePath
-> Maybe FilePath
-> IO (Either Idea (Module_, [Comment]))
parseModuleApply ParseFlags
flags [Setting]
s FilePath
file Maybe FilePath
src
    [Idea] -> IO [Idea]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Idea] -> IO [Idea]) -> [Idea] -> IO [Idea]
forall a b. (a -> b) -> a -> b
$ case Either Idea (Module_, [Comment])
res of
        Left err :: Idea
err -> [Idea
err]
        Right m :: (Module_, [Comment])
m -> [Setting] -> [(Module_, [Comment])] -> [Idea]
executeHints [Setting]
s [(Module_, [Comment])
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 flags :: ParseFlags
flags s :: [Setting]
s files :: [FilePath]
files = do
    (err :: [Idea]
err, ms :: [(Module_, [Comment])]
ms) <- [Either Idea (Module_, [Comment])]
-> ([Idea], [(Module_, [Comment])])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either Idea (Module_, [Comment])]
 -> ([Idea], [(Module_, [Comment])]))
-> IO [Either Idea (Module_, [Comment])]
-> IO ([Idea], [(Module_, [Comment])])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (Either Idea (Module_, [Comment])))
-> [FilePath] -> IO [Either Idea (Module_, [Comment])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\file :: FilePath
file -> ParseFlags
-> [Setting]
-> FilePath
-> Maybe FilePath
-> IO (Either Idea (Module_, [Comment]))
parseModuleApply ParseFlags
flags [Setting]
s FilePath
file Maybe FilePath
forall a. Maybe a
Nothing) [FilePath]
files
    [Idea] -> IO [Idea]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Idea] -> IO [Idea]) -> [Idea] -> IO [Idea]
forall a b. (a -> b) -> a -> b
$ [Idea]
err [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ [Setting] -> [(Module_, [Comment])] -> [Idea]
executeHints [Setting]
s [(Module_, [Comment])]
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 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 -> [(Module SrcSpanInfo, [Comment])] -> [Idea]
applyHints :: [Classify] -> Hint -> [(Module_, [Comment])] -> [Idea]
applyHints cs :: [Classify]
cs = [Setting] -> Hint -> [(Module_, [Comment])] -> [Idea]
applyHintsReal ([Setting] -> Hint -> [(Module_, [Comment])] -> [Idea])
-> [Setting] -> Hint -> [(Module_, [Comment])] -> [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 -> [(Module_, [Comment])] -> [Idea]
applyHintsReal :: [Setting] -> Hint -> [(Module_, [Comment])] -> [Idea]
applyHintsReal settings :: [Setting]
settings hints_ :: Hint
hints_ ms :: [(Module_, [Comment])]
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]
cls [Classify] -> [Classify] -> [Classify]
forall a. [a] -> [a] -> [a]
++ (Annotation S -> Maybe Classify) -> [Annotation S] -> [Classify]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Annotation S -> Maybe Classify
readPragma (Module_ -> [Annotation S]
forall from to. Biplate from to => from -> [to]
universeBi Module_
m) [Classify] -> [Classify] -> [Classify]
forall a. [a] -> [a] -> [a]
++ (Comment -> [Classify]) -> [Comment] -> [Classify]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Comment -> [Classify]
readComment [Comment]
cs) (Idea -> Idea) -> (Idea -> Idea) -> Idea -> Idea
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module_ -> Idea -> Idea
removeRequiresExtensionNotes Module_
m) ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall a b. (a -> b) -> a -> b
$
        [FilePath] -> [Idea] -> [Idea]
order [] (Hint -> [Setting] -> Scope -> Module_ -> [Idea]
hintModule Hint
hints [Setting]
settings Scope
nm Module_
m) [Idea] -> [Idea] -> [Idea]
`merge`
        [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath] -> [Idea] -> [Idea]
order [Decl_ -> FilePath
forall a. Named a => a -> FilePath
fromNamed Decl_
d] ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall a b. (a -> b) -> a -> b
$ Decl_ -> [Idea]
decHints Decl_
d | Decl_
d <- Module_ -> [Decl_]
moduleDecls Module_
m] [Idea] -> [Idea] -> [Idea]
`merge`
        [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath] -> [Idea] -> [Idea]
order [] ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall a b. (a -> b) -> a -> b
$ Hint -> [Setting] -> Comment -> [Idea]
hintComment Hint
hints [Setting]
settings Comment
c | Comment
c <- [Comment]
cs]
    | (nm :: Scope
nm,(m :: Module_
m,cs :: [Comment]
cs)) <- [(Scope, (Module_, [Comment]))]
mns
    , let decHints :: Decl_ -> [Idea]
decHints = Hint -> [Setting] -> Scope -> Module_ -> Decl_ -> [Idea]
hintDecl Hint
hints [Setting]
settings Scope
nm Module_
m -- partially apply
    , let order :: [FilePath] -> [Idea] -> [Idea]
order n :: [FilePath]
n = (Idea -> Idea) -> [Idea] -> [Idea]
forall a b. (a -> b) -> [a] -> [b]
map (\i :: Idea
i -> Idea
i{ideaModule :: [FilePath]
ideaModule= [FilePath] -> [FilePath]
f ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Module_ -> FilePath
moduleName Module_
m FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: Idea -> [FilePath]
ideaModule Idea
i, ideaDecl :: [FilePath]
ideaDecl= [FilePath] -> [FilePath]
f ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
n [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ Idea -> [FilePath]
ideaDecl Idea
i}) ([Idea] -> [Idea]) -> ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Idea -> SrcSpan) -> [Idea] -> [Idea]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn 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 -> SrcSpan) -> Idea -> Idea -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing 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, Module_)] -> [Idea]
hintModules Hint
hints [Setting]
settings ([(Scope, Module_)] -> [Idea]) -> [(Scope, Module_)] -> [Idea]
forall a b. (a -> b) -> a -> b
$ ((Scope, (Module_, [Comment])) -> (Scope, Module_))
-> [(Scope, (Module_, [Comment]))] -> [(Scope, Module_)]
forall a b. (a -> b) -> [a] -> [b]
map (((Module_, [Comment]) -> Module_)
-> (Scope, (Module_, [Comment])) -> (Scope, Module_)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second (Module_, [Comment]) -> Module_
forall a b. (a, b) -> a
fst) [(Scope, (Module_, [Comment]))]
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
/= "")
        cls :: [Classify]
cls = [Classify
x | SettingClassify x :: Classify
x <- [Setting]
settings]
        mns :: [(Scope, (Module_, [Comment]))]
mns = ((Module_, [Comment]) -> (Scope, (Module_, [Comment])))
-> [(Module_, [Comment])] -> [(Scope, (Module_, [Comment]))]
forall a b. (a -> b) -> [a] -> [b]
map (Module_ -> Scope
scopeCreate (Module_ -> Scope)
-> ((Module_, [Comment]) -> Module_)
-> (Module_, [Comment])
-> Scope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Module_, [Comment]) -> Module_
forall a b. (a, b) -> a
fst ((Module_, [Comment]) -> Scope)
-> ((Module_, [Comment]) -> (Module_, [Comment]))
-> (Module_, [Comment])
-> (Scope, (Module_, [Comment]))
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& (Module_, [Comment]) -> (Module_, [Comment])
forall a. a -> a
id) [(Module_, [Comment])]
ms
        hints :: Hint
hints = (if [(Module_, [Comment])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Module_, [Comment])]
ms Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 then Hint -> Hint
noModules else Hint -> Hint
forall a. a -> a
id) Hint
hints_
        noModules :: Hint -> Hint
noModules h :: Hint
h = Hint
h{hintModules :: [Setting] -> [(Scope, Module_)] -> [Idea]
hintModules = \_ _ -> []} Hint -> Hint -> Hint
forall a. Monoid a => a -> a -> a
`mappend` Hint
forall a. Monoid a => a
mempty{hintModule :: [Setting] -> Scope -> Module_ -> [Idea]
hintModule = \s :: [Setting]
s a :: Scope
a b :: Module_
b -> Hint -> [Setting] -> [(Scope, Module_)] -> [Idea]
hintModules Hint
h [Setting]
s [(Scope
a,Module_
b)]}

-- If the hint has said you RequiresExtension Foo, but Foo is enabled, drop the note
removeRequiresExtensionNotes :: Module_ -> Idea -> Idea
removeRequiresExtensionNotes :: Module_ -> Idea -> Idea
removeRequiresExtensionNotes m :: Module_
m = \x :: Idea
x -> Idea
x{ideaNote :: [Note]
ideaNote = (Note -> Bool) -> [Note] -> [Note]
forall a. (a -> Bool) -> [a] -> [a]
filter Note -> Bool
keep ([Note] -> [Note]) -> [Note] -> [Note]
forall a b. (a -> b) -> a -> b
$ Idea -> [Note]
ideaNote Idea
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
$ (Name S -> FilePath) -> [Name S] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Name S -> FilePath
forall a. Named a => a -> FilePath
fromNamed ([Name S] -> [FilePath]) -> [Name S] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Module_ -> [Name S]
moduleExtensions Module_
m
        keep :: Note -> Bool
keep (RequiresExtension x :: 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 _ = 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] -> [(Module_, [Comment])] -> [Idea]
executeHints :: [Setting] -> [(Module_, [Comment])] -> [Idea]
executeHints s :: [Setting]
s = [Setting] -> Hint -> [(Module_, [Comment])] -> [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 (Module_, [Comment]))
parseModuleApply :: ParseFlags
-> [Setting]
-> FilePath
-> Maybe FilePath
-> IO (Either Idea (Module_, [Comment]))
parseModuleApply flags :: ParseFlags
flags s :: [Setting]
s file :: FilePath
file src :: Maybe FilePath
src = do
    Either ParseError (Module_, [Comment])
res <- ParseFlags
-> FilePath
-> Maybe FilePath
-> IO (Either ParseError (Module_, [Comment]))
parseModuleEx ([Fixity] -> ParseFlags -> ParseFlags
parseFlagsAddFixities [Fixity
x | Infix x :: Fixity
x <- [Setting]
s] ParseFlags
flags) FilePath
file Maybe FilePath
src
    case Either ParseError (Module_, [Comment])
res of
        Right m :: (Module_, [Comment])
m -> Either Idea (Module_, [Comment])
-> IO (Either Idea (Module_, [Comment]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Idea (Module_, [Comment])
 -> IO (Either Idea (Module_, [Comment])))
-> Either Idea (Module_, [Comment])
-> IO (Either Idea (Module_, [Comment]))
forall a b. (a -> b) -> a -> b
$ (Module_, [Comment]) -> Either Idea (Module_, [Comment])
forall a b. b -> Either a b
Right (Module_, [Comment])
m
        Left (ParseError sl :: SrcLoc
sl msg :: FilePath
msg ctxt :: FilePath
ctxt) ->
            Either Idea (Module_, [Comment])
-> IO (Either Idea (Module_, [Comment]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Idea (Module_, [Comment])
 -> IO (Either Idea (Module_, [Comment])))
-> Either Idea (Module_, [Comment])
-> IO (Either Idea (Module_, [Comment]))
forall a b. (a -> b) -> a -> b
$ Idea -> Either Idea (Module_, [Comment])
forall a b. a -> Either a b
Left (Idea -> Either Idea (Module_, [Comment]))
-> Idea -> Either Idea (Module_, [Comment])
forall a b. (a -> b) -> a -> b
$ [Classify] -> Idea -> Idea
classify [Classify
x | SettingClassify x :: 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 "Parse error" (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
sl SrcLoc
sl) FilePath
ctxt Maybe FilePath
forall a. Maybe a
Nothing []


-- | Find which hints a list of settings implies.
allHints :: [Setting] -> Hint
allHints :: [Setting] -> Hint
allHints xs :: [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 x :: 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
== "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 x :: FilePath
x <- [Setting]
xs]
          f :: FilePath -> Hint
f x :: 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
$ "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 xs :: [Classify]
xs i :: Idea
i =  let s :: Severity
s = (Severity -> Classify -> Severity)
-> Severity -> [Classify] -> Severity
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 :: Severity
ideaSeverity=Severity
s}
    where
        -- figure out if we need to change the severity
        f :: Idea -> Severity -> Classify -> Severity
        f :: Idea -> Severity -> Classify -> Severity
f i :: Idea
i r :: Severity
r c :: Classify
c | Classify -> FilePath
classifyHint Classify
c FilePath -> [FilePath] -> Bool
forall (t :: * -> *) (t :: * -> *) a.
(Foldable t, Foldable t, Eq (t a)) =>
t a -> t (t a) -> Bool
~= [Idea -> FilePath
ideaHint Idea
i] Bool -> Bool -> Bool
&& Classify -> FilePath
classifyModule Classify
c FilePath -> [FilePath] -> Bool
forall (t :: * -> *) (t :: * -> *) a.
(Foldable t, Foldable t, Eq (t a)) =>
t a -> t (t a) -> Bool
~= Idea -> [FilePath]
ideaModule Idea
i Bool -> Bool -> Bool
&& Classify -> FilePath
classifyDecl Classify
c FilePath -> [FilePath] -> Bool
forall (t :: * -> *) (t :: * -> *) a.
(Foldable t, Foldable t, Eq (t a)) =>
t a -> t (t a) -> Bool
~= Idea -> [FilePath]
ideaDecl Idea
i = Classify -> Severity
classifySeverity Classify
c
                | Bool
otherwise = Severity
r
        x :: t a
x ~= :: t a -> t (t a) -> Bool
~= y :: t (t a)
y = t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
x Bool -> Bool -> Bool
|| t a
x t a -> t (t a) -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t (t a)
y