From 6ca61240e5491cce571eabcf83fb637d2199aea7 Mon Sep 17 00:00:00 2001
From: meck <johan@meck.se>
Date: Thu, 18 Oct 2018 13:07:21 +0200
Subject: [PATCH] Quickfix action to prefix unused terms with '_'

---
 src/Haskell/Ide/Engine/Plugin/GhcMod.hs      | 31 ++++++++++++++++++++
 test/functional/FunctionalCodeActionsSpec.hs | 23 +++++++++++++++
 test/testdata/UnusedTerm.hs                  |  6 ++++
 test/unit/CodeActionsSpec.hs                 |  5 ++++
 4 files changed, 65 insertions(+)
 create mode 100644 test/testdata/UnusedTerm.hs

diff --git a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs
index f7a0ac282..f413150b7 100644
--- a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs
+++ b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs
@@ -410,10 +410,13 @@ codeActionProvider' supportsDocChanges _ docId _ _ _ context =
       typedHoleActions = concatMap mkTypedHoleActions (mapMaybe getTypedHoles diags)
       missingSignatures = mapMaybe getMissingSignatures diags
       topLevelSignatureActions = map (uncurry mkMissingSignatureAction) missingSignatures
+      unusedTerms = mapMaybe getUnusedTerms diags
+      unusedTermActions = map (uncurry mkUnusedTermAction) unusedTerms
   in return $ IdeResultOk $ concat [ renameActions
                                    , redundantActions
                                    , typedHoleActions
                                    , topLevelSignatureActions
+                                   , unusedTermActions
                                    ]
 
   where
@@ -512,6 +515,26 @@ codeActionProvider' supportsDocChanges _ docId _ _ _ context =
             kind = LSP.CodeActionQuickFix
             codeAction = LSP.CodeAction title (Just kind) (Just diags) (Just edit) Nothing
 
+    getUnusedTerms :: LSP.Diagnostic -> Maybe (LSP.Diagnostic, T.Text)
+    getUnusedTerms diag@(LSP.Diagnostic _ _ _ (Just "ghcmod") msg _) =
+      case extractUnusedTerm msg of
+        Nothing -> Nothing
+        Just signature -> Just (diag, signature)
+    getUnusedTerms _ = Nothing
+
+    mkUnusedTermAction :: LSP.Diagnostic -> T.Text -> LSP.CodeAction
+    mkUnusedTermAction diag term = LSP.CodeAction title (Just kind) (Just diags) Nothing (Just cmd)
+      where title :: T.Text
+            title = "Prefix " <> term <> " with _"
+            diags = LSP.List [diag]
+            newTerm = "_" <> term
+            pos = diag ^. (LSP.range . LSP.start)
+            kind = LSP.CodeActionQuickFix
+            cmdArgs = LSP.List
+              [ Object $ HM.fromList [("file", toJSON docUri),("pos", toJSON pos), ("text", toJSON newTerm)]]
+            -- The command label isen't used since the command is never presented to the user
+            cmd  = LSP.Command "Unused command label" "hare:rename" (Just cmdArgs)
+
 extractRenamableTerms :: T.Text -> [T.Text]
 extractRenamableTerms msg
   -- Account for both "Variable not in scope" and "Not in scope"
@@ -601,6 +624,14 @@ extractMissingSignature msg = extractSignature <$> stripMessageStart msg
                       . T.strip
     extractSignature = T.strip
 
+extractUnusedTerm :: T.Text -> Maybe T.Text
+extractUnusedTerm msg = extractTerm <$> stripMessageStart msg
+  where
+    stripMessageStart = T.stripPrefix "Defined but not used:"
+                      . T.strip
+    extractTerm       = T.dropWhile (== '‘')
+                      . T.dropWhileEnd (== '’')
+                      . T.dropAround (\c -> c /= '‘' && c /= '’')
 
 -- ---------------------------------------------------------------------
 
diff --git a/test/functional/FunctionalCodeActionsSpec.hs b/test/functional/FunctionalCodeActionsSpec.hs
index 80349d11a..fa563873a 100644
--- a/test/functional/FunctionalCodeActionsSpec.hs
+++ b/test/functional/FunctionalCodeActionsSpec.hs
@@ -301,6 +301,29 @@ spec = describe "code actions" $ do
 
         liftIO $ contents `shouldBe` expected
 
+  describe "unused term code actions" $
+    it "Prefixes with '_'" $
+      runSession hieCommand fullCaps "test/testdata/" $ do
+        doc <- openDoc "UnusedTerm.hs" "haskell"
+
+        _ <- waitForDiagnosticsSource "ghcmod"
+        cas <- map fromAction <$> getAllCodeActions doc
+
+        liftIO $ map (^. L.title) cas `shouldContain` [ "Prefix imUnused with _"]
+
+        executeCodeAction $ head cas
+
+        edit <- getDocumentEdit doc
+
+        let expected = "{-# OPTIONS_GHC -Wall #-}\n\
+                        \module UnusedTerm () where\n\
+                        \_imUnused :: Int -> Int\n\
+                        \_imUnused 1 = 1\n\
+                        \_imUnused 2 = 2\n\
+                        \_imUnused _ = 3\n"
+
+        liftIO $ edit `shouldBe` expected
+
 fromAction :: CAResult -> CodeAction
 fromAction (CACodeAction action) = action
 fromAction _ = error "Not a code action"
diff --git a/test/testdata/UnusedTerm.hs b/test/testdata/UnusedTerm.hs
new file mode 100644
index 000000000..e49c2e8d0
--- /dev/null
+++ b/test/testdata/UnusedTerm.hs
@@ -0,0 +1,6 @@
+{-# OPTIONS_GHC -Wall #-}
+module UnusedTerm () where
+imUnused :: Int -> Int
+imUnused 1 = 1
+imUnused 2 = 2
+imUnused _ = 3
diff --git a/test/unit/CodeActionsSpec.hs b/test/unit/CodeActionsSpec.hs
index c3612a6dd..2c5738cdb 100644
--- a/test/unit/CodeActionsSpec.hs
+++ b/test/unit/CodeActionsSpec.hs
@@ -146,3 +146,8 @@ spec = do
                 \                              Text.Megaparsec.Error.ShowErrorComponent e, Ord t) =>\n\
                 \                             OutputFormat -> Format.Result t e -> IO b"
         in extractMissingSignature msg `shouldBe` Just expected
+  
+  describe "unused term code actions" $ do
+    it "pick up unused term" $
+      let msg = "  Defined but not used: ‘imUnused’"
+       in extractUnusedTerm msg `shouldBe` Just "imUnused"