Skip to content

getRestrictItem returns a lits of hints #1648

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

getRestrictItem returns a lits of hints #1648

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
157 changes: 83 additions & 74 deletions src/Hint/Restrict.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -164,88 +164,97 @@ checkPragmas modu flags exts mps =
data QualifiedPostOrPre = QualifiedPostOrPre deriving Eq

checkImports :: String -> [LImportDecl GhcPs] -> (Bool, Map.Map String RestrictItem) -> [Idea]
checkImports modu lImportDecls (def, mp) = mapMaybe getImportHint lImportDecls
checkImports modu lImportDecls (def, mp) = concatMap getImportHint lImportDecls
where
getImportHint :: LImportDecl GhcPs -> Maybe Idea
getImportHint :: LImportDecl GhcPs -> [Idea]
getImportHint i@(L _ ImportDecl{..}) = do
let RestrictItem{..} = getRestrictItem def ideclName mp
either (Just . ideaMessage riMessage) (const Nothing) $ do
unless (within modu "" riWithin) $
Left $ ideaNoTo $ warn "Avoid restricted module" (reLoc i) (reLoc i) []

let importedIdents = Set.fromList $
case first (== EverythingBut) <$> ideclImportList of
Just (False, lxs) -> concatMap (importListToIdents . unLoc) (unLoc lxs)
_ -> []
invalidIdents = case riRestrictIdents of
NoRestrictIdents -> Set.empty
ForbidIdents badIdents -> importedIdents `Set.intersection` Set.fromList badIdents
OnlyIdents onlyIdents -> importedIdents `Set.difference` Set.fromList onlyIdents
unless (Set.null invalidIdents) $
Left $ ideaNoTo $ warn "Avoid restricted identifiers" (reLoc i) (reLoc i) []

let qualAllowed = case (riAs, ideclAs) of
([], _) -> True
(_, Nothing) -> maybe True not $ getAlt riAsRequired
(_, Just (L _ modName)) -> moduleNameString modName `elem` riAs
unless qualAllowed $ do
let i' = noLoc $ (unLoc i){ ideclAs = noLocA . mkModuleName <$> listToMaybe riAs }
Left $ warn "Avoid restricted alias" (reLoc i) i' []

let (expectedQual, expectedHiding) =
case fromMaybe ImportStyleUnrestricted $ getAlt riImportStyle of
ImportStyleUnrestricted
| NotQualified <- ideclQualified -> (Nothing, Nothing)
| otherwise -> (Just $ second (<> " or unqualified") expectedQualStyle, Nothing)
ImportStyleQualified -> (Just expectedQualStyle, Nothing)
ImportStyleExplicitOrQualified
| Just (False, _) <- first (== EverythingBut) <$> ideclImportList -> (Nothing, Nothing)
| otherwise ->
( Just $ second (<> " or with an explicit import list") expectedQualStyle
, Nothing )
ImportStyleExplicit
| Just (False, _) <- first (== EverythingBut) <$> ideclImportList -> (Nothing, Nothing)
| otherwise ->
( Just (Right NotQualified, "unqualified")
, Just $ Just (Exactly, noLocA []) )
ImportStyleUnqualified -> (Just (Right NotQualified, "unqualified"), Nothing)
expectedQualStyle =
case fromMaybe QualifiedStyleUnrestricted $ getAlt riQualifiedStyle of
QualifiedStyleUnrestricted -> (Left QualifiedPostOrPre, "qualified")
QualifiedStylePost -> (Right QualifiedPost, "post-qualified")
QualifiedStylePre -> (Right QualifiedPre, "pre-qualified")
-- unless expectedQual is Nothing, it holds the Idea (hint) to ultimately emit,
-- except in these cases when the rule's requirements are fulfilled in-source:
qualIdea
-- the rule demands a particular importStyle, and the decl obeys exactly
| Just (Right ideclQualified) == (fst <$> expectedQual) = Nothing
-- the rule demands a QualifiedPostOrPre import, and the decl does either
| Just (Left QualifiedPostOrPre) == (fst <$> expectedQual)
&& ideclQualified `elem` [QualifiedPost, QualifiedPre] = Nothing
-- otherwise, expectedQual gets converted into a warning below (or is Nothing)
| otherwise = expectedQual
whenJust qualIdea $ \(qual, hint) -> do
-- convert non-Nothing qualIdea into hlint's refactoring Idea
let i' = noLoc $ (unLoc i){ ideclQualified = fromRight QualifiedPre qual
, ideclImportList = fromMaybe ideclImportList expectedHiding }
msg = moduleNameString (unLoc ideclName) <> " should be imported " <> hint
Left $ warn msg (reLoc i) i' []

getRestrictItem :: Bool -> LocatedA ModuleName -> Map.Map String RestrictItem -> RestrictItem
getRestrictItem def ideclName =
fromMaybe (RestrictItem mempty mempty mempty mempty [("","") | def] NoRestrictIdents Nothing)
. lookupRestrictItem ideclName

lookupRestrictItem :: LocatedA ModuleName -> Map.Map String RestrictItem -> Maybe RestrictItem
let restrictItems = getRestrictItem def ideclName mp
flip mapMaybe restrictItems $ \RestrictItem {..} ->
either (Just . ideaMessage riMessage) (const Nothing) $ do
unless (within modu "" riWithin) $
Left $ ideaNoTo $ warn "Avoid restricted module" (reLoc i) (reLoc i) []

let importedIdents = Set.fromList $
case first (== EverythingBut) <$> ideclImportList of
Just (False, lxs) -> concatMap (importListToIdents . unLoc) (unLoc lxs)
_ -> []
invalidIdents = case riRestrictIdents of
NoRestrictIdents -> Set.empty
ForbidIdents badIdents -> importedIdents `Set.intersection` Set.fromList badIdents
OnlyIdents onlyIdents -> importedIdents `Set.difference` Set.fromList onlyIdents
unless (Set.null invalidIdents) $
Left $ ideaNoTo $ warn "Avoid restricted identifiers" (reLoc i) (reLoc i) []

let qualAllowed = case (riAs, ideclAs) of
([], _) -> True
(_, Nothing) -> maybe True not $ getAlt riAsRequired
(_, Just (L _ modName)) -> moduleNameString modName `elem` riAs
unless qualAllowed $ do
let i' = noLoc $ (unLoc i){ ideclAs = noLocA . mkModuleName <$> listToMaybe riAs }
Left $ warn "Avoid restricted alias" (reLoc i) i' []

let (expectedQual, expectedHiding) =
case fromMaybe ImportStyleUnrestricted $ getAlt riImportStyle of
ImportStyleUnrestricted
| NotQualified <- ideclQualified -> (Nothing, Nothing)
| otherwise -> (Just $ second (<> " or unqualified") expectedQualStyle, Nothing)
ImportStyleQualified -> (Just expectedQualStyle, Nothing)
ImportStyleExplicitOrQualified
| Just (False, _) <- first (== EverythingBut) <$> ideclImportList -> (Nothing, Nothing)
| otherwise ->
( Just $ second (<> " or with an explicit import list") expectedQualStyle
, Nothing )
ImportStyleExplicit
| Just (False, _) <- first (== EverythingBut) <$> ideclImportList -> (Nothing, Nothing)
| otherwise ->
( Just (Right NotQualified, "unqualified")
, Just $ Just (Exactly, noLocA []) )
ImportStyleUnqualified -> (Just (Right NotQualified, "unqualified"), Nothing)
expectedQualStyle =
case fromMaybe QualifiedStyleUnrestricted $ getAlt riQualifiedStyle of
QualifiedStyleUnrestricted -> (Left QualifiedPostOrPre, "qualified")
QualifiedStylePost -> (Right QualifiedPost, "post-qualified")
QualifiedStylePre -> (Right QualifiedPre, "pre-qualified")
-- unless expectedQual is Nothing, it holds the Idea (hint) to ultimately emit,
-- except in these cases when the rule's requirements are fulfilled in-source:
qualIdea
-- the rule demands a particular importStyle, and the decl obeys exactly
| Just (Right ideclQualified) == (fst <$> expectedQual) = Nothing
-- the rule demands a QualifiedPostOrPre import, and the decl does either
| Just (Left QualifiedPostOrPre) == (fst <$> expectedQual)
&& ideclQualified `elem` [QualifiedPost, QualifiedPre] = Nothing
-- otherwise, expectedQual gets converted into a warning below (or is Nothing)
| otherwise = expectedQual
whenJust qualIdea $ \(qual, hint) -> do
-- convert non-Nothing qualIdea into hlint's refactoring Idea
let i' = noLoc $ (unLoc i){ ideclQualified = fromRight QualifiedPre qual
, ideclImportList = fromMaybe ideclImportList expectedHiding }
msg = moduleNameString (unLoc ideclName) <> " should be imported " <> hint
Left $ warn msg (reLoc i) i' []

getRestrictItem :: Bool -> LocatedA ModuleName -> Map.Map String RestrictItem -> [RestrictItem]
getRestrictItem def ideclName mp =
case lookupRestrictItem ideclName mp of
[] ->
pure (RestrictItem mempty mempty mempty mempty [("","") | def] NoRestrictIdents Nothing)
restricts ->
restricts

lookupRestrictItem :: LocatedA ModuleName -> Map.Map String RestrictItem -> [RestrictItem]
lookupRestrictItem ideclName mp =
let moduleName = moduleNameString $ unLoc ideclName
exact = Map.lookup moduleName mp
wildcard = nonEmpty
mexact = Map.lookup moduleName mp
wildcard = catMaybes . NonEmpty.toList . sequence . nonEmpty
. fmap snd
. reverse -- the hope is less specific matches will end up last, but it's not guaranteed
. filter (liftA2 (&&) (elem '*') (`wildcardMatch` moduleName) . fst)
$ Map.toList mp
in exact <> sconcat (sequence wildcard)
in
case mexact of
Nothing ->
wildcard
Comment on lines +254 to +255
Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

In this branch, we had no exact match, meaning that wildcard contains all of the wildcard matches that hit. This means we have multiple wildcard rules that should be checked, and we probably don't want to combine these...

I can see some logic where "nested" rules should be combined, but totally disparate rules should not be. Like, Handler.** and Handler.Foo.** maybe should be combined because of the shared literal prefix. But **.*Spec and Handler.** should not, even though they have overlaps in Handler.FooSpec.

Just exact ->
[sconcat (exact NonEmpty.:| wildcard)]
Comment on lines +256 to +257
Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This preserves the old behavior: take the exact match and concat the rest of the rules into it.


importListToIdents :: IE GhcPs -> [String]
importListToIdents =
Expand Down