Additional code actions/quick fixes

CHANGELOG.md

@@ -1,5 +1,14 @@
 # Revision history for static-ls
 
+## Unreleased -- 2025-07-06
+  * New code actions/quick fixes
+    * Add required extension
+    * Insert associated type
+    * Insert cases
+    * Insert fields
+    * Insert missing methods
+    * Use valid hole fit
+
 ## 1.0.0 -- 2024-09-24
   * Re-architect to use tree-sitter and in memory representation of file system
   * New features:

src/StaticLS/HIE/File.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module StaticLS.HIE.File (
+  getHieFileFromTdi,
   modToHieFile,
   modToSrcFile,
   srcFilePathToHieFilePath,
@@ -25,14 +26,15 @@ import Control.Monad.IO.Unlift (MonadIO, liftIO)
 import Control.Monad.Trans.Maybe
 import Data.Bifunctor (first, second)
 import Data.Map qualified as Map
-import Data.Path (AbsPath)
+import Data.Path (AbsPath, filePathToAbs)
 import Data.Path qualified as Path
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as T.Encoding
 import GHC.Iface.Ext.Binary qualified as GHC
 import GHC.Iface.Ext.Types qualified as GHC
 import GHC.Types.Name.Cache qualified as GHC
 import HieDb qualified
+import Language.LSP.Protocol.Types qualified as LSP
 import StaticLS.FilePath
 import StaticLS.HIE.File.Except
 import StaticLS.HieDb qualified as HieDb
@@ -46,14 +48,21 @@ import System.FilePath ((</>))
 
 type HieFile = GHC.HieFile
 
+-- | Retrieve a hie info from a lsp text document identifier
+getHieFileFromTdi :: (HasStaticEnv m, HasLogger m, MonadIO m) => LSP.TextDocumentIdentifier -> MaybeT m GHC.HieFile
+getHieFileFromTdi = getHieFileFromPath <=< tdiToHieFilePath
+
+tdiToHieFilePath :: (HasStaticEnv m, MonadIO m) => LSP.TextDocumentIdentifier -> MaybeT m AbsPath
+tdiToHieFilePath = srcFilePathToHieFilePath <=< filePathToAbs <=< (MaybeT . pure . LSP.uriToFilePath . (._uri))
+
 getHieSource :: GHC.HieFile -> T.Text
 getHieSource hieFile = T.Encoding.decodeUtf8 $ GHC.hie_hs_src hieFile
 
 -- | Retrieve a hie info from a lsp text document identifier
 -- Returns a Maybe instead of throwing because we want to handle
 -- the case when there is no hie file and do something reasonable
 -- Most functions that get the file text will throw if the file text is not found
-getHieFileFromPath :: (HasStaticEnv m, HasLogger m, MonadIO m, HasLogger m) => AbsPath -> MaybeT m HieFile
+getHieFileFromPath :: (HasStaticEnv m, HasLogger m, MonadIO m) => AbsPath -> MaybeT m HieFile
 getHieFileFromPath = ((exceptToMaybeT . getHieFileFromHiePath) <=< srcFilePathToHieFilePath)
 
 -- | Retrieve an hie file from a module name

src/StaticLS/Handlers.hs

@@ -219,12 +219,12 @@ handleCodeAction = LSP.requestHandler LSP.SMethod_TextDocumentCodeAction $ \req
   _ <- lift $ logInfo "handleCodeAction"
   let params = req._params
   let tdi = params._textDocument
+  let ctx = params._context
   path <- ProtoLSP.uriToAbsPath tdi._uri
   let range = params._range
   let lineCol = (ProtoLSP.lineColFromProto range._start)
-  assists <- lift $ getCodeActions path lineCol
-  codeActions <- lift $ traverse ProtoLSP.assistToCodeAction assists
-  res (Right (LSP.InL (fmap LSP.InR codeActions)))
+  codeActions <- lift $ getCodeActions tdi ctx path lineCol
+  res $ Right $ LSP.InL $ fmap LSP.InR codeActions
   pure ()
 
 handleResolveCodeAction :: Handlers (LspT c StaticLsM)

src/StaticLS/IDE/CodeActions.hs

@@ -5,32 +5,74 @@
 
 module StaticLS.IDE.CodeActions where
 
+import Control.Error (mapMaybe)
+import Control.Monad (join)
 import Data.LineCol (LineCol (..))
 import Data.Path (AbsPath)
 import Data.Rope qualified as Rope
+import Data.Set qualified as S
+import Language.LSP.Protocol.Types qualified as LSP
+import StaticLS.IDE.CodeActions.AddRequiredExtension qualified as AddRequiredExtension
 import StaticLS.IDE.CodeActions.AddTypeSig qualified as AddTypeSig
 import StaticLS.IDE.CodeActions.AutoImport qualified as AutoImport
-import StaticLS.IDE.CodeActions.RemoveRedundantImports as RemoveRedundantImports
+import StaticLS.IDE.CodeActions.InsertAssociatedType qualified as InsertAssociatedType
+import StaticLS.IDE.CodeActions.InsertCases qualified as InsertCases
+import StaticLS.IDE.CodeActions.InsertFields qualified as InsertFields
+import StaticLS.IDE.CodeActions.InsertMissingMethods qualified as InsertMissingMethods
+import StaticLS.IDE.CodeActions.Parse qualified as Parse
+import StaticLS.IDE.CodeActions.RemoveRedundantImports qualified as RemoveRedundantImports
 import StaticLS.IDE.CodeActions.Types
+import StaticLS.IDE.CodeActions.UseValidHoleFit qualified as UseValidHoleFit
 import StaticLS.IDE.Monad
 import StaticLS.IDE.SourceEdit (SourceEdit)
 import StaticLS.IDE.SourceEdit qualified as SourceEdit
 import StaticLS.Monad (StaticLsM)
+import StaticLS.ProtoLSP (assistToCodeAction)
 
-getCodeActions :: AbsPath -> LineCol -> StaticLsM [Assist]
-getCodeActions path lineCol = do
+getCodeActions ::
+  LSP.TextDocumentIdentifier ->
+  LSP.CodeActionContext ->
+  AbsPath ->
+  LineCol ->
+  StaticLsM [LSP.CodeAction]
+getCodeActions tdi ctx path lineCol = do
   rope <- getSourceRope path
   let pos = Rope.lineColToPos rope lineCol
   let cx = CodeActionContext {path, pos, lineCol}
   typesCodeActions <- AddTypeSig.codeAction cx
   importCodeActions <- AutoImport.codeAction cx
   removeRedundantImports <- RemoveRedundantImports.codeAction cx
-  let codeActions = typesCodeActions ++ importCodeActions ++ removeRedundantImports
-  pure codeActions
+  let issues = S.fromList (mapMaybe Parse.actionableIssue ctx._diagnostics)
+  issueActions <- join <$> traverse (issueToActions tdi) (S.toList issues)
+  assistActions <-
+    traverse assistToCodeAction $
+      typesCodeActions
+        ++ importCodeActions
+        ++ removeRedundantImports
+  pure $ assistActions ++ issueActions
 
 resolveLazyAssist :: CodeActionMessage -> StaticLsM SourceEdit
 resolveLazyAssist (CodeActionMessage {kind, path}) = do
   case kind of
     AutoImportActionMessage toImport -> AutoImport.resolveLazy path toImport
     NoMessage -> do
       pure SourceEdit.empty
+
+issueToActions ::
+  LSP.TextDocumentIdentifier ->
+  Parse.ActionableIssue ->
+  StaticLsM [LSP.CodeAction]
+issueToActions tdi issue =
+  case issue of
+    Parse.MissingMethods (Parse.Ignored diag) methods ->
+      pure [InsertMissingMethods.codeAction tdi diag methods]
+    Parse.MissingAssociatedType (Parse.Ignored diag) ty ->
+      pure [InsertAssociatedType.codeAction tdi diag ty]
+    Parse.MissingFields (Parse.Ignored diag) ctor ext flds ->
+      pure [InsertFields.codeAction tdi diag ctor ext flds]
+    Parse.MissingCasses (Parse.Ignored diag) pats ->
+      pure [InsertCases.codeAction tdi diag pats]
+    Parse.RequiredExtension (Parse.Ignored diag) ext ->
+      pure [AddRequiredExtension.codeAction tdi diag ext]
+    Parse.TypedHoleFits (Parse.Ignored diag) fits ->
+      pure $ UseValidHoleFit.codeAction tdi diag <$> fits

src/StaticLS/IDE/CodeActions/AddRequiredExtension.hs

@@ -0,0 +1,25 @@
+module StaticLS.IDE.CodeActions.AddRequiredExtension where
+
+import StaticLS.IDE.CodeActions.Utils
+
+import Data.Text qualified as T
+import Language.LSP.Protocol.Types qualified as LSP
+import StaticLS.IDE.CodeActions.Parse qualified as Parse
+
+codeAction ::
+  LSP.TextDocumentIdentifier ->
+  LSP.Diagnostic ->
+  Parse.KnownExtension ->
+  LSP.CodeAction
+codeAction = addRequiredExtension
+
+addRequiredExtension ::
+  LSP.TextDocumentIdentifier ->
+  LSP.Diagnostic ->
+  Parse.KnownExtension ->
+  LSP.CodeAction
+addRequiredExtension tdi diag (Parse.KnownExtension _ text) =
+  let title = "Add language extension: " <> text
+      txt = T.concat ["{-# LANGUAGE ", text, " #-}\n"]
+      rng = insertAt 0 0
+   in prefer $ quickFix tdi diag title rng txt

src/StaticLS/IDE/CodeActions/InsertAssociatedType.hs

@@ -0,0 +1,14 @@
+module StaticLS.IDE.CodeActions.InsertAssociatedType where
+
+import Data.Text qualified as T
+import Language.LSP.Protocol.Types qualified as LSP
+import StaticLS.IDE.CodeActions.Utils (insertBelow, prefer, quickFix)
+
+codeAction :: LSP.TextDocumentIdentifier -> LSP.Diagnostic -> T.Text -> LSP.CodeAction
+codeAction = insertAssociatedType
+
+insertAssociatedType :: LSP.TextDocumentIdentifier -> LSP.Diagnostic -> T.Text -> LSP.CodeAction
+insertAssociatedType tdi diag ty =
+  let rng = insertBelow diag._range
+      txt = T.concat ["    type ", ty, " = ()\n"]
+   in prefer $ quickFix tdi diag "Insert associated type." rng txt

src/StaticLS/IDE/CodeActions/InsertCases.hs

@@ -0,0 +1,16 @@
+module StaticLS.IDE.CodeActions.InsertCases where
+
+import StaticLS.IDE.CodeActions.Utils
+
+import Data.Text qualified as T
+import Language.LSP.Protocol.Types qualified as LSP
+
+codeAction :: LSP.TextDocumentIdentifier -> LSP.Diagnostic -> [T.Text] -> LSP.CodeAction
+codeAction = insertCases
+
+insertCases :: LSP.TextDocumentIdentifier -> LSP.Diagnostic -> [T.Text] -> LSP.CodeAction
+insertCases tdi diag pats =
+  let spaces = indentation diag._range
+      rng = insertBelow diag._range
+      cases = foldMap (\pat -> spaces <> pat <> " -> _") pats
+   in prefer $ quickFix tdi diag "Insert cases." rng cases

src/StaticLS/IDE/CodeActions/InsertFields.hs

@@ -0,0 +1,33 @@
+module StaticLS.IDE.CodeActions.InsertFields where
+
+import Data.Text qualified as T
+import Language.LSP.Protocol.Types qualified as LSP
+import StaticLS.IDE.CodeActions.Utils (indentation, prefer, quickFix)
+
+codeAction ::
+  LSP.TextDocumentIdentifier ->
+  LSP.Diagnostic ->
+  T.Text ->
+  Maybe T.Text ->
+  [T.Text] ->
+  LSP.CodeAction
+codeAction = insertFields
+
+insertFields ::
+  LSP.TextDocumentIdentifier ->
+  LSP.Diagnostic ->
+  T.Text ->
+  Maybe T.Text ->
+  [T.Text] ->
+  LSP.CodeAction
+insertFields tdi diag ctor existingFields missingFields =
+  let spaces = indentation diag._range
+      seps = "{ " : repeat ", "
+      formatNewField sep fld = T.concat [spaces, sep, fld, " = _"]
+      formatOldFields flds = T.concat [spaces, ", ", flds]
+      newFields = zipWith formatNewField seps missingFields
+      allFields = case existingFields of
+        Nothing -> newFields
+        Just flds -> newFields <> [formatOldFields flds]
+      renderedExpr = T.concat [ctor, "\n" <> T.unlines allFields <> spaces <> "}\n"]
+   in prefer $ quickFix tdi diag "Insert fields." (diag._range) renderedExpr

src/StaticLS/IDE/CodeActions/InsertMissingMethods.hs

@@ -0,0 +1,15 @@
+module StaticLS.IDE.CodeActions.InsertMissingMethods where
+
+import StaticLS.IDE.CodeActions.Utils
+
+import Data.Text qualified as T
+import Language.LSP.Protocol.Types qualified as LSP
+
+codeAction :: LSP.TextDocumentIdentifier -> LSP.Diagnostic -> [T.Text] -> LSP.CodeAction
+codeAction = insertMissingMethods
+
+insertMissingMethods :: LSP.TextDocumentIdentifier -> LSP.Diagnostic -> [T.Text] -> LSP.CodeAction
+insertMissingMethods tdi diag methods =
+  let rng = insertBelow diag._range
+      txt = T.concat ["    ", T.intercalate " = _\n    " methods, "\n"]
+   in prefer $ quickFix tdi diag "Insert missing methods." rng txt