Demonstrate that listify is lazy

In `findAliasUseAtPos`, `listify` only produces `RdrName` elements until
it finds one whose alias is at the cursor. This element is consumed
through pattern matching; `listify` then stops traversing and produces
no more elements.

See the new test cases in `Main.hs`.

Author: izuzu

plugins/hls-rename-plugin/src/Ide/Plugin/Rename/ImportAlias.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -Wall -Werror #-}
+{-# OPTIONS_GHC -Wall #-}
 
 {-| Logic for renaming qualified import aliases.
 
@@ -47,6 +47,7 @@ import           Data.Generics
 import qualified Data.Map                         as M
 import           Data.Maybe
 import qualified Data.Text                        as T
+import           Debug.Trace                      (trace, traceShowWith)
 import           Development.IDE                  (realSrcSpanToCodePointRange)
 import           Development.IDE.Core.FileStore   (getVersionedTextDoc)
 import           Development.IDE.Core.PluginUtils
@@ -55,6 +56,7 @@ import           Development.IDE.Core.Service     hiding (Log)
 import           Development.IDE.Core.Shake       hiding (Log)
 import           Development.IDE.GHC.Compat       hiding (importDecl)
 import           GHC.Data.FastString              (lengthFS)
+import           GHC.Utils.Outputable             (showPprUnsafe)
 import           Ide.Plugin.Error
 import qualified Language.LSP.Protocol.Lens       as L
 import           Language.LSP.Protocol.Message
@@ -193,8 +195,7 @@ findAliasUseAtPos ::
     Maybe (VFS.CodePointRange, [ImportAlias])
 findAliasUseAtPos pos exports imports hsDecls =
     let qualifiersAtPos = do
-            locatedRdrName :: XRec GhcPs RdrName <-
-                listify (const True) exports ++ listify (const True) hsDecls
+            locatedRdrName <- locateRdrNames exports hsDecls True
             Qual qualifier _ <- [unLoc locatedRdrName]
             RealSrcSpan qualifiedNameSpan _ <- [getLoc locatedRdrName]
             let qualifiedNameRange = realSrcSpanToCodePointRange qualifiedNameSpan
@@ -204,7 +205,7 @@ findAliasUseAtPos pos exports imports hsDecls =
                 qualifierRange = qualifiedNameRange
                     & VFS.end .~ (qualifierStart & VFS.character +~ qualifierLength)
             guard (rangeContainsPositionInclusive qualifierRange pos)
-            [(qualifierRange, qualifier)]
+            traceShowWith (\x -> "findAliasUseAtPos/qualifierAtPos: " <> show x) [(qualifierRange, qualifier)]
     in case qualifiersAtPos of
         [] -> Nothing
         (rangeAtPos, qualifierAtPos) : _ -> Just $ (,) rangeAtPos $ do
@@ -229,8 +230,7 @@ aliasUseSiteRanges ::
 aliasUseSiteRanges importAlias exports hsDecls = nubOrd $ do
     let ImportAlias{aliasName} = importAlias
         aliasLength = fromIntegral (moduleNameLength aliasName)
-    locatedRdrName :: XRec GhcPs RdrName <-
-        listify (const True) exports ++ listify (const True) hsDecls
+    locatedRdrName <- locateRdrNames exports hsDecls False
     Qual qualifier _ <- [unLoc locatedRdrName]
     guard (qualifier == aliasName)
     RealSrcSpan qualifiedNameSpan _ <- [getLoc locatedRdrName]
@@ -275,8 +275,7 @@ aliasUseSiteRangesDisambiguated tcModule importAlias exports hsDecls = nubOrd $
     let rdrEnv = tcg_rdr_env (tmrTypechecked tcModule)
         ImportAlias{aliasModuleName, aliasName} = importAlias
         aliasLength = fromIntegral (moduleNameLength aliasName)
-    locatedRdrName :: XRec GhcPs RdrName <-
-        listify (const True) exports ++ listify (const True) hsDecls
+    locatedRdrName <- locateRdrNames exports hsDecls False
     rdrName@(Qual qualifier name) <- [unLoc locatedRdrName]
     guard (qualifier == aliasName)
     nameGREElement <- pickGREs rdrName $ lookupGlobalRdrEnv rdrEnv name
@@ -306,6 +305,24 @@ ambiguousAliasErrorMessage _ = ""
 ---------------------------------------------------------------------------------------------------
 -- Utility functions
 
+instance Show RdrName where
+    show (Unqual name)          = show name
+    show (Qual moduleName name) = show moduleName ++ "." ++ show name
+    show (Orig mod name)        = "Orig: " <> show mod <> "." <> show name
+    show (Exact name)           = "Exact: " <> showPprUnsafe name
+
+-- | Locate 'RdrName' identifiers in the given export list and declarations.
+locateRdrNames ::
+    Maybe (XRec GhcPs [LIE GhcPs]) ->
+    [LHsDecl GhcPs] ->
+    Bool ->
+    [XRec GhcPs RdrName]
+locateRdrNames exports hsDecls traceEveryProducedName =
+    listify const_True exports ++ listify const_True hsDecls
+    where const_True = if traceEveryProducedName
+            then \x -> trace ("listify: " <> show (unLoc x) <> " at " <> show (getLoc x)) True
+            else const True
+
 -- | Check whether a 'CodePointRange' contains a 'CodePointPosition' (inclusive
 -- start, inclusive end).
 -- NOTE: The use of inclusive end allows the user to place the cursor at the end

plugins/hls-rename-plugin/test/Main.hs

@@ -130,6 +130,24 @@ renameTests = testGroup "Identifier"
         rename doc (Position 3 31) "Maybe"
     , goldenWithRename "Import alias at use site (shared by unrelated imports)" "ImportAliasShared" $ \doc ->
         rename doc (Position 6 6) "Maybe"
+
+    -- REVIEW: `listify (const True) exports` produces 2 elements. The 2nd one,
+    -- `M.isJust`, has its alias at the cursor. The `qualifiersAtPos` pattern
+    -- match consumes it, and then doesn't consume any more elements. `listify
+    -- exports` then stops, and `listify hsDecls` is not evaluated at all.
+    -- The console shows 2 `listify:` traces.
+    , goldenWithRename "Import alias in export list (proving 'listify' is lazy)" "ImportAliasLazyListify" $ \doc ->
+        rename doc (Position 0 39) "Maybe"
+
+    -- REVIEW: `listify (const True) exports ++ listify (const True) hsDecls`
+    -- produces elements until it produces one whose alias is at the cursor.
+    -- This element is then consumed in the pattern match. `listify` then stops
+    -- producing.
+    -- The console shows traces for all `RdrName`s except for the `M.fromMaybe`
+    -- on the last line.
+    , goldenWithRename "Import alias in definition (proving 'listify' is lazy)" "ImportAliasLazyListify" $ \doc ->
+        rename doc (Position 9 6) "Maybe"
+
     , goldenWithRename "Import alias declaration (with re-exports)" "ImportAliasReexport" $ \doc -> do
         rename doc (Position 1 18) "Reexport"
     , testCase "Import alias at use site (ambiguous due to re-exports)" $ runRenameSession "" $ do

plugins/hls-rename-plugin/test/testdata/ImportAliasLazyListify.expected.hs

@@ -0,0 +1,13 @@
+module ImportAliasShared (Maybe.fromMaybe, Maybe.isJust, Maybe.maybe, M.mapM) where
+
+import qualified Control.Monad as M
+import qualified Data.Maybe as Maybe
+
+bar :: Maybe a -> Bool
+bar = Maybe.isJust
+
+baz :: b -> (a -> b) -> Maybe a -> b
+baz = Maybe.maybe
+
+buzz :: a -> Maybe a -> a
+buzz = Maybe.fromMaybe

plugins/hls-rename-plugin/test/testdata/ImportAliasLazyListify.hs

@@ -0,0 +1,13 @@
+module ImportAliasShared (M.fromMaybe, M.isJust, M.maybe, M.mapM) where
+
+import qualified Control.Monad as M
+import qualified Data.Maybe as M
+
+bar :: Maybe a -> Bool
+bar = M.isJust
+
+baz :: b -> (a -> b) -> Maybe a -> b
+baz = M.maybe
+
+buzz :: a -> Maybe a -> a
+buzz = M.fromMaybe