From ed37b61f81db72579cedf8069f1725d8f7de67be Mon Sep 17 00:00:00 2001
From: Torsten Scholak <torsten.scholak@googlemail.com>
Date: Tue, 24 Aug 2021 11:30:53 -0400
Subject: [PATCH] don't crash when an unused operator import ends in `.`
 (#2123)

* replace head with safer uncons

* if empty, stay empty

* add test for removal of operators ending with '.'

* make remove-import-actions tests pass

* add more tests and debug output for modifyBinding

* implement reviewers suggestions

* restore ghcide/bench/example/HLS

Co-authored-by: Pepe Iborra <pepeiborra@gmail.com>
---
 .../src/Development/IDE/Plugin/CodeAction.hs  | 15 +++----
 ghcide/test/exe/Main.hs                       | 39 +++++++++++++++++++
 2 files changed, 47 insertions(+), 7 deletions(-)

diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs
index 05c2075881..41a508335d 100644
--- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs
+++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs
@@ -1483,20 +1483,21 @@ rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range]
 rangesForBindingImport ImportDecl{ideclHiding = Just (False, L _ lies)} b =
     concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies
   where
-    b' = modifyBinding b
+    b' = wrapOperatorInParens b
 rangesForBindingImport _ _ = []
 
-modifyBinding :: String -> String
-modifyBinding = wrapOperatorInParens . unqualify
-  where
-    wrapOperatorInParens x = if isAlpha (head x) then x else "(" <> x <> ")"
-    unqualify x = snd $ breakOnEnd "." x
+wrapOperatorInParens :: String -> String
+wrapOperatorInParens x =
+  case uncons x of
+    Just (h, _t) -> if isAlpha h then x else "(" <> x <> ")"
+    Nothing      -> mempty
 
 smallerRangesForBindingExport :: [LIE GhcPs] -> String -> [Range]
 smallerRangesForBindingExport lies b =
     concatMap (mapMaybe srcSpanToRange . ranges') lies
   where
-    b' = modifyBinding b
+    unqualify = snd . breakOnEnd "."
+    b' = wrapOperatorInParens . unqualify $ b
     ranges' (L _ (IEThingWith _ thing _  inners labels))
       | showSDocUnsafe (ppr thing) == b' = []
       | otherwise =
diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
index ecf4e24f01..d93b81631f 100644
--- a/ghcide/test/exe/Main.hs
+++ b/ghcide/test/exe/Main.hs
@@ -1150,6 +1150,33 @@ removeImportTests = testGroup "remove import actions"
             , "type T = K.Type"
             ]
       liftIO $ expectedContentAfterAction @=? contentAfterAction
+  , testSession "remove unused operators whose name ends with '.'" $ do
+      let contentA = T.unlines
+            [ "module ModuleA where"
+            , "(@.) = 0 -- Must have an operator whose name ends with '.'"
+            , "a = 1 -- .. but also something else"
+            ]
+      _docA <- createDoc "ModuleA.hs" "haskell" contentA
+      let contentB = T.unlines
+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"
+            , "module ModuleB where"
+            , "import ModuleA (a, (@.))"
+            , "x = a -- Must use something from module A, but not (@.)"
+            ]
+      docB <- createDoc "ModuleB.hs" "haskell" contentB
+      _ <- waitForDiagnostics
+      [InR action@CodeAction { _title = actionTitle }, _]
+          <- getCodeActions docB (Range (Position 2 0) (Position 2 5))
+      liftIO $ "Remove @. from import" @=? actionTitle
+      executeCodeAction action
+      contentAfterAction <- documentContents docB
+      let expectedContentAfterAction = T.unlines
+            [ "{-# OPTIONS_GHC -Wunused-imports #-}"
+            , "module ModuleB where"
+            , "import ModuleA (a)"
+            , "x = a -- Must use something from module A, but not (@.)"
+            ]
+      liftIO $ expectedContentAfterAction @=? contentAfterAction
   ]
 
 extendImportTests :: TestTree
@@ -3311,6 +3338,18 @@ removeExportTests = testGroup "remove export actions"
               , "import qualified Data.List as M"
               , "a :: ()"
               , "a = ()"])
+    , testSession "qualified re-export ending in '.'" $ template
+        (T.unlines
+              [ "module A ((M.@.),a) where"
+              , "import qualified Data.List as M"
+              , "a :: ()"
+              , "a = ()"])
+        "Remove ‘M.@.’ from export"
+        (Just $ T.unlines
+              [ "module A (a) where"
+              , "import qualified Data.List as M"
+              , "a :: ()"
+              , "a = ()"])
     , testSession "export module" $ template
         (T.unlines
               [ "module A (module B) where"