Skip to content
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.

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

[Patch+test] Fix bug with postqualified imports and qualifiedStyle=unrestricted #1498

Merged
merged 4 commits into from
Sep 19, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
2 changes: 2 additions & 0 deletions data/import_style.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -4,3 +4,5 @@
- {name: HypotheticalModule3, importStyle: qualified}
- {name: 'HypotheticalModule3.*', importStyle: unqualified}
- {name: 'HypotheticalModule3.OtherSubModule', importStyle: unrestricted, qualifiedStyle: post}
- {name: HypotheticalModule4, importStyle: qualified, as: HM4, asRequired: true}
- {name: HypotheticalModule5, importStyle: qualified, qualifiedStyle: post}
35 changes: 24 additions & 11 deletions src/Hint/Restrict.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,7 @@ import Data.Set qualified as Set
import Data.Map qualified as Map
import Data.List.Extra
import Data.List.NonEmpty (nonEmpty)
import Data.Either
import Data.Maybe
import Data.Monoid
import Data.Semigroup
Expand Down Expand Up @@ -157,6 +158,11 @@ checkPragmas modu flags exts mps =
, not $ null bad]
isGood def mp x = maybe def (within modu "" . riWithin) $ Map.lookup x mp


-- | Extension to GHC's 'ImportDeclQualifiedStyle', expressing @qualifiedStyle: unrestricted@,
-- i.e. the preference of "either pre- or post-, but qualified" in a rule.
data QualifiedPostOrPre = QualifiedPostOrPre deriving Eq
ulidtko marked this conversation as resolved.
Show resolved Hide resolved

checkImports :: String -> [LImportDecl GhcPs] -> (Bool, Map.Map String RestrictItem) -> [Idea]
checkImports modu lImportDecls (def, mp) = mapMaybe getImportHint lImportDecls
where
Expand Down Expand Up @@ -190,30 +196,37 @@ checkImports modu lImportDecls (def, mp) = mapMaybe getImportHint lImportDecls
case fromMaybe ImportStyleUnrestricted $ getAlt riImportStyle of
ImportStyleUnrestricted
| NotQualified <- ideclQualified -> (Nothing, Nothing)
| otherwise -> (second (<> " or unqualified") <$> expectedQualStyle, Nothing)
ImportStyleQualified -> (expectedQualStyleDef, Nothing)
| otherwise -> (Just $ second (<> " or unqualified") expectedQualStyle, Nothing)
ImportStyleQualified -> (Just expectedQualStyle, Nothing)
ImportStyleExplicitOrQualified
| Just (False, _) <- first (== EverythingBut) <$> ideclImportList -> (Nothing, Nothing)
| otherwise ->
( second (<> " or with an explicit import list") <$> expectedQualStyleDef
( Just $ second (<> " or with an explicit import list") expectedQualStyle
, Nothing )
ImportStyleExplicit
| Just (False, _) <- first (== EverythingBut) <$> ideclImportList -> (Nothing, Nothing)
| otherwise ->
( Just (NotQualified, "unqualified")
( Just (Right NotQualified, "unqualified")
, Just $ Just (Exactly, noLocA []) )
ImportStyleUnqualified -> (Just (NotQualified, "unqualified"), Nothing)
expectedQualStyleDef = expectedQualStyle <|> Just (QualifiedPre, "qualified")
Copy link
Contributor Author

@ulidtko ulidtko Apr 21, 2023

Choose a reason for hiding this comment

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

My ID of the root cause is this line 206 👀

Right here, QualifiedStyleUnrestricted (no pre-/post- preference) was getting mapped into QualifiedPre.

ImportStyleUnqualified -> (Just (Right NotQualified, "unqualified"), Nothing)
expectedQualStyle =
case fromMaybe QualifiedStyleUnrestricted $ getAlt riQualifiedStyle of
QualifiedStyleUnrestricted -> Nothing
QualifiedStylePost -> Just (QualifiedPost, "post-qualified")
QualifiedStylePre -> Just (QualifiedPre, "pre-qualified")
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
| Just ideclQualified == (fst <$> expectedQual) = Nothing
-- the rule demands a particular importStyle, and the decl obeys exactly
| Just (Right ideclQualified) == (fst <$> expectedQual) = Nothing
ulidtko marked this conversation as resolved.
Show resolved Hide resolved
-- the rule demands a QualifiedPostOrPre import, and the decl does either
| Just (Left QualifiedPostOrPre) == (fst <$> expectedQual)
&& ideclQualified `elem` [QualifiedPost, QualifiedPre] = Nothing
ulidtko marked this conversation as resolved.
Show resolved Hide resolved
-- otherwise, expectedQual gets converted into a warning below (or is Nothing)
| otherwise = expectedQual
whenJust qualIdea $ \(qual, hint) -> do
let i' = noLoc $ (unLoc i){ ideclQualified = qual
-- convert non-Nothing qualIdea into hlint's refactoring Idea
let i' = noLoc $ (unLoc i){ ideclQualified = fromRight QualifiedPre qual
ulidtko marked this conversation as resolved.
Show resolved Hide resolved
, ideclImportList = fromMaybe ideclImportList expectedHiding }
msg = moduleNameString (unLoc ideclName) <> " should be imported " <> hint
Left $ warn msg (reLoc i) i' []
Expand Down
61 changes: 61 additions & 0 deletions tests/import_style.test
Original file line number Diff line number Diff line change
Expand Up @@ -66,3 +66,64 @@ OUTPUT
No hints

---------------------------------------------------------------------
RUN tests/importStyle-postqual-pos.hs --hint=data/import_style.yaml -XImportQualifiedPost
FILE tests/importStyle-postqual-pos.hs
import HypotheticalModule1 qualified as HM1
import HypotheticalModule2 qualified
import HypotheticalModule2 qualified as Arbitrary
import HypotheticalModule3 qualified
import HypotheticalModule3 qualified as Arbitrary
import HypotheticalModule4 qualified as HM4
import HypotheticalModule5 qualified
import HypotheticalModule5 qualified as HM5
OUTPUT
No hints

---------------------------------------------------------------------
RUN tests/importStyle-postqual-neg.hs --hint=data/import_style.yaml -XImportQualifiedPost
FILE tests/importStyle-postqual-neg.hs
import HypotheticalModule1 qualified
import qualified HypotheticalModule4
import qualified HypotheticalModule4 as Verbotten
import qualified HypotheticalModule4 as HM4
import HypotheticalModule5 as HM5
import qualified HypotheticalModule5

OUTPUT
tests/importStyle-postqual-neg.hs:1:1-36: Warning: Avoid restricted alias
Found:
import HypotheticalModule1 qualified
Perhaps:
import HypotheticalModule1 qualified as HM1
Note: may break the code

tests/importStyle-postqual-neg.hs:2:1-36: Warning: Avoid restricted alias
Found:
import qualified HypotheticalModule4
Perhaps:
import qualified HypotheticalModule4 as HM4
Note: may break the code

tests/importStyle-postqual-neg.hs:3:1-49: Warning: Avoid restricted alias
Found:
import qualified HypotheticalModule4 as Verbotten
Perhaps:
import qualified HypotheticalModule4 as HM4
Note: may break the code

tests/importStyle-postqual-neg.hs:5:1-33: Warning: HypotheticalModule5 should be imported post-qualified
Found:
import HypotheticalModule5 as HM5
Perhaps:
import HypotheticalModule5 qualified as HM5
Note: may break the code

tests/importStyle-postqual-neg.hs:6:1-36: Warning: HypotheticalModule5 should be imported post-qualified
Found:
import qualified HypotheticalModule5
Perhaps:
import HypotheticalModule5 qualified
Note: may break the code

5 hints
---------------------------------------------------------------------
Loading