From e760b31702a660d6938bddbc573105d42a0280ed Mon Sep 17 00:00:00 2001 From: Maxim Ivanov Date: Tue, 19 Sep 2023 04:39:00 +0300 Subject: [PATCH] Fix bug with postqualified imports and qualifiedStyle=unrestricted (#1498) --- data/import_style.yaml | 2 ++ src/Hint/Restrict.hs | 35 +++++++++++++++-------- tests/import_style.test | 61 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 87 insertions(+), 11 deletions(-) diff --git a/data/import_style.yaml b/data/import_style.yaml index f53ff4ab2..f8730e193 100644 --- a/data/import_style.yaml +++ b/data/import_style.yaml @@ -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} diff --git a/src/Hint/Restrict.hs b/src/Hint/Restrict.hs index 4314b343e..f6fcd53bb 100644 --- a/src/Hint/Restrict.hs +++ b/src/Hint/Restrict.hs @@ -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 @@ -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 @@ -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' [] diff --git a/tests/import_style.test b/tests/import_style.test index f641726a5..e264eed35 100644 --- a/tests/import_style.test +++ b/tests/import_style.test @@ -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 +---------------------------------------------------------------------