Refactor HaRe mkCodeActions

Author: Avi-D-coder

src/Haskell/Ide/Engine/Plugin/HaRe.hs

@@ -359,60 +359,37 @@ hoist f a =
 codeActionProvider :: CodeActionProvider
 codeActionProvider pId docId _ _ (J.Range pos _) _ =
   pluginGetFile "HaRe codeActionProvider: " (docId ^. J.uri) $ \file ->
-    ifCachedInfo file (IdeResultOk mempty) $ \info ->
+    ifCachedInfo file (IdeResultOk mempty) $ \info -> do
       case getArtifactsAtPos pos (defMap info) of
-        [h] -> do
+        [h] ->
           let name = Hie.showName $ snd h
-          debugm $ show name
-          IdeResultOk <$> sequence [
-              mkLiftOneAction name
-            , mkLiftTopAction name
-            , mkDemoteAction name
-            , mkDeleteAction name
-            , mkDuplicateAction name
+            in IdeResultOk <$> sequence [
+              mkAction "liftonelevel"
+                J.CodeActionRefactorExtract $ "Lift " <> name <> " one level"
+            , mkAction "lifttotoplevel"
+                J.CodeActionRefactorExtract $"Lift " <> name <> " to top level"
+            , mkAction "demote"
+                J.CodeActionRefactorInline $ "Demote " <> name <> " one level"
+            , mkAction "deletedef"
+                J.CodeActionRefactor $ "Delete definition of " <> name
+            , mkHptAction "dupdef"
+                J.CodeActionRefactor "Duplicate definition of " name
             ]
         _   -> case getArtifactsAtPos pos (locMap info) of
-               [h] -> do
+               [h] ->
                 let name = Hie.showName $ snd h
-                debugm $ show name
-                IdeResultOk <$> sequence [
-                  mkCaseSplitAction name
+                  in IdeResultOk <$> sequence [
+                    mkAction "casesplit"
+                      J.CodeActionRefactorRewrite $ "Case split on " <> name
                   ]
                _   -> return $ IdeResultOk []
 
   where
-    mkLiftOneAction name = do
+    mkAction aId kind title = do
       let args = [J.toJSON $ HP (docId ^. J.uri) pos]
-          title = "Lift " <> name <> " one level"
-      liftCmd <- mkLspCommand pId "liftonelevel" title (Just args)
-      return $ J.CodeAction title (Just J.CodeActionRefactorExtract) mempty Nothing (Just liftCmd)
-
-    mkLiftTopAction name = do
-      let args = [J.toJSON $ HP (docId ^. J.uri) pos]
-          title = "Lift " <> name <> " to top level"
-      liftCmd <- mkLspCommand pId "lifttotoplevel" title (Just args)
-      return $ J.CodeAction title (Just J.CodeActionRefactorExtract) mempty Nothing (Just liftCmd)
-
-    mkDemoteAction name = do
-      let args = [J.toJSON $ HP (docId ^. J.uri) pos]
-          title = "Demote " <> name <> " one level"
-      demCmd <- mkLspCommand pId "demote" title (Just args)
-      return $ J.CodeAction title (Just J.CodeActionRefactorInline) mempty Nothing (Just demCmd)
-
-    mkDeleteAction name = do
-      let args = [J.toJSON $ HP (docId ^. J.uri) pos]
-          title = "Delete definition of " <> name
-      delCmd <- mkLspCommand pId "deletedef" title (Just args)
-      return $ J.CodeAction title (Just J.CodeActionRefactor) mempty Nothing (Just delCmd)
-
-    mkDuplicateAction name = do
+      cmd <- mkLspCommand pId aId title (Just args)
+      return $ J.CodeAction title (Just kind) mempty Nothing (Just cmd)
+    mkHptAction aId kind title name = do
       let args = [J.toJSON $ HPT (docId ^. J.uri) pos (name <> "'")]
-          title = "Duplicate definition of " <> name
-      dupCmd <- mkLspCommand pId "dupdef" title (Just args)
-      return $ J.CodeAction title (Just J.CodeActionRefactor) mempty Nothing (Just dupCmd)
-
-    mkCaseSplitAction name = do
-      let args = [J.toJSON $ HP (docId ^. J.uri) pos]
-          title = "Case split on " <> name
-      splCmd <- mkLspCommand pId "casesplit" title (Just args)
-      return $ J.CodeAction title (Just J.CodeActionRefactorRewrite) mempty Nothing (Just splCmd)
+      cmd <- mkLspCommand pId aId title (Just args)
+      return $ J.CodeAction (title <> name) (Just kind) mempty Nothing (Just cmd)