Skip to content

Commit

Permalink
Fix bug with postqualified imports and qualifiedStyle=unrestricted (#…
Browse files Browse the repository at this point in the history
  • Loading branch information
ulidtko authored Sep 19, 2023
1 parent 2cb667e commit e760b31
Show file tree
Hide file tree
Showing 3 changed files with 87 additions and 11 deletions.
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

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")
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
-- 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
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
, 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
---------------------------------------------------------------------

0 comments on commit e760b31

Please sign in to comment.