Fix bug with postqualified imports and qualifiedStyle=unrestricted (#1498)

Author: ulidtko

Diff for: 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 for: 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 for: 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
+---------------------------------------------------------------------