Add support for frontend-emitted quick fixes

src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs

@@ -2,25 +2,21 @@
 module Curry.LanguageServer.Handlers.TextDocument.CodeAction (codeActionHandler) where
 
 -- Curry Compiler Libraries + Dependencies
-import qualified Curry.Syntax as CS
-import qualified Curry.Frontend.Base.Types as CT
+import qualified Curry.Base.Message as CM
 
 import Control.Lens ((^.))
-import Control.Monad (guard)
+import Control.Monad.Extra (mapMaybeM)
 import Control.Monad.IO.Class (MonadIO (..))
 import Control.Monad.Trans (lift)
 import Control.Monad.Trans.Maybe (runMaybeT)
 import qualified Curry.LanguageServer.Config as CFG
 import qualified Curry.LanguageServer.Index.Store as I
 import Curry.LanguageServer.Monad (LSM)
-import Curry.LanguageServer.Utils.Convert (currySpanInfo2Uri, currySpanInfo2Range, ppToText)
+import Curry.LanguageServer.Utils.Convert (curryQuickFix2CodeAction, curryMsg2Diagnostic)
 import Curry.LanguageServer.Utils.General (rangeOverlaps)
 import Curry.LanguageServer.Utils.Logging (debugM)
-import Curry.LanguageServer.Utils.Sema (untypedTopLevelDecls)
 import Curry.LanguageServer.Utils.Uri (normalizeUriWithPath)
-import qualified Data.Aeson as A
-import Data.Maybe (fromMaybe, maybeToList)
-import qualified Data.Text as T
+import Data.Maybe (fromMaybe)
 import qualified Language.LSP.Server as S
 import Language.LSP.Server (MonadLsp)
 import qualified Language.LSP.Protocol.Types as J
@@ -35,40 +31,23 @@ codeActionHandler = S.requestHandler J.SMethod_TextDocumentCodeAction $ \req res
     normUri <- normalizeUriWithPath uri
     actions <- runMaybeT $ do
         entry <- I.getModule normUri
-        lift $ fetchCodeActions range entry
+        lift $ fetchCodeActionsInRange range entry
     responder $ Right $ J.InL $ J.InR <$> fromMaybe [] actions
 
-fetchCodeActions :: (MonadIO m, MonadLsp CFG.Config m) => J.Range -> I.ModuleStoreEntry -> m [J.CodeAction]
-fetchCodeActions range entry = do
-    actions <- maybe (pure []) (codeActions range) entry.moduleAST
-    debugM $ "Found " <> T.pack (show (length actions)) <> " code action(s)"
-    return actions
-
-class HasCodeActions s where
-    codeActions :: MonadIO m => J.Range -> s -> m [J.CodeAction]
-
-instance HasCodeActions (CS.Module (Maybe CT.PredType)) where
-    codeActions range mdl@(CS.Module spi _ _ _ _ _ _) = do
-        maybeUri <- runMaybeT (currySpanInfo2Uri spi)
-
-        -- TODO: Attach diagnostics, ideally the frontend could emit these
-        --       quick fixes along with the warning messages?
-
-        let typeHintActions = do
-                (spi', i, tp) <- untypedTopLevelDecls mdl
-                t <- maybeToList tp
-                range' <- maybeToList $ currySpanInfo2Range spi'
-                guard $ rangeOverlaps range range'
-                uri <- maybeToList maybeUri
-                -- TODO: Move the command identifier ('decl.applyTypeHint') to some
-                --       central place to avoid repetition.
-                let text = ppToText i <> " :: " <> ppToText t
-                    args = [A.toJSON uri, A.toJSON $ range' ^. J.start, A.toJSON text]
-                    command = J.Command text "decl.applyTypeHint" $ Just args
-                    caKind = J.CodeActionKind_QuickFix
-                    isPreferred = True
-                    lens = J.CodeAction ("Add type annotation '" <> text <> "'") (Just caKind) Nothing (Just isPreferred) Nothing Nothing (Just command) Nothing
-                return lens
-
-        return typeHintActions
-
+fetchCodeActionsInRange :: (MonadIO m, MonadLsp CFG.Config m) => J.Range -> I.ModuleStoreEntry -> m [J.CodeAction]
+fetchCodeActionsInRange range entry = filterCodeActionsInRange range <$> fetchCodeActions entry
+
+filterCodeActionsInRange :: J.Range -> [J.CodeAction] -> [J.CodeAction]
+filterCodeActionsInRange range = filter $ \a -> any (rangeOverlaps range)
+    [ txtEdit ^. J.range
+    | Just workspaceEdit <- [a ^. J.edit]
+    , Just changes <- [workspaceEdit ^. J.documentChanges]
+    , J.InL docEdit <- changes
+    , J.InL txtEdit <- docEdit ^. J.edits
+    ]
+
+fetchCodeActions :: (MonadIO m, MonadLsp CFG.Config m) => I.ModuleStoreEntry -> m [J.CodeAction]
+fetchCodeActions entry = do
+    let msgs = entry.warningMessages ++ entry.errorMessages
+        diags = [curryMsg2Diagnostic s m | (s, ms) <- zip [J.DiagnosticSeverity_Warning, J.DiagnosticSeverity_Error] [entry.warningMessages, entry.errorMessages], m <- ms]
+    mapMaybeM (runMaybeT . uncurry curryQuickFix2CodeAction) [(f, [diag]) | (diag, m) <- zip diags msgs, f <- CM.msgFixes m]

src/Curry/LanguageServer/Utils/Convert.hs

@@ -16,6 +16,10 @@ module Curry.LanguageServer.Utils.Convert
     , currySpanInfo2Location
     , currySpanInfo2LocationLink
     , currySpanInfos2LocationLink
+    , curryTextEdit2TextEdit
+    , curryTextEdit2TextDocumentEdit
+    , curryTextEdit2WorkspaceEdit
+    , curryQuickFix2CodeAction
     , setCurryPosUri
     , setCurrySpanUri
     , setCurrySpanInfoUri
@@ -36,6 +40,8 @@ import qualified Curry.Base.Position as CP
 import qualified Curry.Base.Pretty as CPP
 import qualified Curry.Base.Span as CSP
 import qualified Curry.Base.SpanInfo as CSPI
+import qualified Curry.Base.TextEdit as CTE
+import qualified Curry.Base.QuickFix as CQF
 import qualified Curry.Syntax as CS
 import qualified Curry.Frontend.Base.Types as CT
 import qualified Text.PrettyPrint as PP
@@ -140,6 +146,31 @@ currySpanInfos2LocationLink (CSPI.getSpanInfo -> CSPI.NoSpanInfo) spi = currySpa
 currySpanInfos2LocationLink (CSPI.getSpanInfo -> CSPI.SpanInfo{srcSpan=srcSpan}) (CSPI.getSpanInfo -> CSPI.SpanInfo {srcSpan=destSpan}) = currySpans2LocationLink srcSpan destSpan
 currySpanInfos2LocationLink _ _ = liftMaybe Nothing
 
+curryTextEdit2TextEdit :: MonadIO m => CTE.TextEdit -> MaybeT m J.TextEdit
+curryTextEdit2TextEdit (CTE.TextEdit s e t) = do
+    s' <- liftMaybe $ curryPos2Pos s
+    e' <- liftMaybe $ curryPos2Pos e
+    let range = J.Range s' e'
+    return $ J.TextEdit range (T.pack t)
+
+curryTextEdit2TextDocumentEdit :: MonadIO m => CTE.TextEdit -> MaybeT m J.TextDocumentEdit
+curryTextEdit2TextDocumentEdit e = do
+    uri <- curryPos2Uri $ CTE.editStart e
+    let doc = J.OptionalVersionedTextDocumentIdentifier uri $ J.InL 0
+    tedit <- curryTextEdit2TextEdit e
+    return $ J.TextDocumentEdit doc [J.InL tedit]
+
+curryTextEdit2WorkspaceEdit :: MonadIO m => CTE.TextEdit -> MaybeT m J.WorkspaceEdit
+curryTextEdit2WorkspaceEdit e = do
+    docEdit <- curryTextEdit2TextDocumentEdit e
+    return $ J.WorkspaceEdit Nothing (Just [J.InL docEdit]) Nothing
+
+curryQuickFix2CodeAction :: MonadIO m => CQF.QuickFix -> [J.Diagnostic] -> MaybeT m J.CodeAction
+curryQuickFix2CodeAction (CQF.QuickFix e desc) diags = do
+    wedit <- curryTextEdit2WorkspaceEdit e
+    return $ J.CodeAction (T.pack desc) (Just kind) (Just diags) Nothing Nothing (Just wedit) Nothing Nothing
+    where kind = J.CodeActionKind_QuickFix
+
 setCurryPosUri :: CP.HasPosition a => J.Uri -> a -> Maybe a
 setCurryPosUri uri x@(CP.getPosition -> p@(CP.Position {})) = do
     fp <- uriToFilePath uri

stack.yaml

@@ -34,7 +34,7 @@ extra-deps:
   - unix-2.8.5.1
   - Win32-2.14.1.0
   - git: https://git.ps.informatik.uni-kiel.de/curry/curry-frontend.git
-    commit: 81d57ee6515efb2b21fc3820ddb13c7a8badcad3
+    commit: 3904e70913651b522eef3e7febe90c54564d9c18
 
 allow-newer: true
 

stack.yaml.lock

@@ -124,15 +124,15 @@ packages:
   original:
     hackage: Win32-2.14.1.0
 - completed:
-    commit: 81d57ee6515efb2b21fc3820ddb13c7a8badcad3
+    commit: 3904e70913651b522eef3e7febe90c54564d9c18
     git: https://git.ps.informatik.uni-kiel.de/curry/curry-frontend.git
     name: curry-frontend
     pantry-tree:
-      sha256: 5a71cac15a58cf2f38efab6c8f772a58cc40266373e350328b644f106a8d469c
-      size: 21476
+      sha256: 78878966a6bb00c266eb65f2f8a6fc630908bf5dba1de7176c9353cf4e2a87e6
+      size: 21750
     version: 3.0.0
   original:
-    commit: 81d57ee6515efb2b21fc3820ddb13c7a8badcad3
+    commit: 3904e70913651b522eef3e7febe90c54564d9c18
     git: https://git.ps.informatik.uni-kiel.de/curry/curry-frontend.git
 snapshots:
 - completed: