{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE LambdaCase               #-}
{-# LANGUAGE OverloadedStrings        #-}
{-| This module currently includes helper functions to provide fallback support
to code actions that use resolve in HLS. The difference between the two
functions for code actions that don't support resolve is that
mkCodeActionHandlerWithResolve will immediately resolve your code action before
sending it on to the client, while  mkCodeActionWithResolveAndCommand will turn
your resolve into a command.

General support for resolve in HLS can be used with mkResolveHandler from
Ide.Types. Resolve theoretically should allow us to delay computation of parts
of the request till the client needs it, allowing us to answer requests faster
and with less resource usage.
-}
module Ide.Plugin.Resolve
(mkCodeActionHandlerWithResolve,
mkCodeActionWithResolveAndCommand) where

import           Control.Lens                  (_Just, (&), (.~), (?~), (^.),
                                                (^?))
import           Control.Monad.Error.Class     (MonadError (throwError))
import           Control.Monad.Trans.Class     (lift)
import           Control.Monad.Trans.Except    (ExceptT (..))

import qualified Data.Aeson                    as A
import           Data.Maybe                    (catMaybes)
import qualified Data.Text                     as T
import           GHC.Generics                  (Generic)
import           Ide.Logger
import           Ide.Plugin.Error
import           Ide.Types
import qualified Language.LSP.Protocol.Lens    as L
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types

data Log
    = DoesNotSupportResolve T.Text
    | forall m . A.ToJSON (ErrorData m) => ApplyWorkspaceEditFailed (TResponseError m)
instance Pretty Log where
    pretty :: forall ann. Log -> Doc ann
pretty = \case
        DoesNotSupportResolve Text
fallback->
            Doc ann
"Client does not support resolve," Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
fallback
        ApplyWorkspaceEditFailed TResponseError m
err ->
            Doc ann
"ApplyWorkspaceEditFailed:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TResponseError m -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TResponseError m -> Doc ann
pretty TResponseError m
err

-- |When provided with both a codeAction provider and an affiliated codeAction
-- resolve provider, this function creates a handler that automatically uses
-- your resolve provider to fill out you original codeAction if the client doesn't
-- have codeAction resolve support. This means you don't have to check whether
-- the client supports resolve and act accordingly in your own providers.
mkCodeActionHandlerWithResolve
  :: forall ideState a. (A.FromJSON a) =>
  Recorder (WithPriority Log)
  -> PluginMethodHandler ideState 'Method_TextDocumentCodeAction
  -> ResolveFunction ideState a 'Method_CodeActionResolve
  -> PluginHandlers ideState
mkCodeActionHandlerWithResolve :: forall ideState a.
FromJSON a =>
Recorder (WithPriority Log)
-> PluginMethodHandler ideState 'Method_TextDocumentCodeAction
-> ResolveFunction ideState a 'Method_CodeActionResolve
-> PluginHandlers ideState
mkCodeActionHandlerWithResolve Recorder (WithPriority Log)
recorder PluginMethodHandler ideState 'Method_TextDocumentCodeAction
codeActionMethod ResolveFunction ideState a 'Method_CodeActionResolve
codeResolveMethod =
  let newCodeActionMethod :: ideState
-> PluginId
-> CodeActionParams
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
newCodeActionMethod ideState
ideState PluginId
pid CodeActionParams
params =
        do [Command |? CodeAction] |? Null
codeActionReturn <- PluginMethodHandler ideState 'Method_TextDocumentCodeAction
codeActionMethod ideState
ideState PluginId
pid MessageParams 'Method_TextDocumentCodeAction
CodeActionParams
params
           ClientCapabilities
caps <- HandlerM Config ClientCapabilities
-> ExceptT PluginError (HandlerM Config) ClientCapabilities
forall (m :: * -> *) a. Monad m => m a -> ExceptT PluginError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift HandlerM Config ClientCapabilities
forall config. HandlerM config ClientCapabilities
pluginGetClientCapabilities
           case [Command |? CodeAction] |? Null
codeActionReturn of
             r :: [Command |? CodeAction] |? Null
r@(InR Null
Null) -> ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Command |? CodeAction] |? Null
r
             (InL [Command |? CodeAction]
ls) | -- We don't need to do anything if the client supports
                        -- resolve
                        ClientCapabilities -> Bool
supportsCodeActionResolve ClientCapabilities
caps -> ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Command |? CodeAction] |? Null)
 -> ExceptT
      PluginError (HandlerM Config) ([Command |? CodeAction] |? Null))
-> ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
InL [Command |? CodeAction]
ls
                        --This is the actual part where we call resolveCodeAction which fills in the edit data for the client
                      | Bool
otherwise -> do
                        Recorder (WithPriority Log)
-> Priority -> Log -> ExceptT PluginError (HandlerM Config) ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Debug (Text -> Log
DoesNotSupportResolve Text
"filling in the code action")
                        [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
InL ([Command |? CodeAction] -> [Command |? CodeAction] |? Null)
-> ExceptT PluginError (HandlerM Config) [Command |? CodeAction]
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Command |? CodeAction)
 -> ExceptT PluginError (HandlerM Config) (Command |? CodeAction))
-> [Command |? CodeAction]
-> ExceptT PluginError (HandlerM Config) [Command |? CodeAction]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Uri
-> ideState
-> PluginId
-> (Command |? CodeAction)
-> ExceptT PluginError (HandlerM Config) (Command |? CodeAction)
resolveCodeAction (CodeActionParams
params CodeActionParams -> Getting Uri CodeActionParams Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> CodeActionParams -> Const Uri CodeActionParams
forall s a. HasTextDocument s a => Lens' s a
Lens' CodeActionParams TextDocumentIdentifier
L.textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> CodeActionParams -> Const Uri CodeActionParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> Getting Uri CodeActionParams Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
L.uri) ideState
ideState PluginId
pid) [Command |? CodeAction]
ls
  in (SClientMethod 'Method_TextDocumentCodeAction
-> PluginMethodHandler ideState 'Method_TextDocumentCodeAction
-> PluginHandlers ideState
forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction PluginMethodHandler ideState 'Method_TextDocumentCodeAction
ideState
-> PluginId
-> CodeActionParams
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
newCodeActionMethod
  PluginHandlers ideState
-> PluginHandlers ideState -> PluginHandlers ideState
forall a. Semigroup a => a -> a -> a
<> SClientMethod 'Method_CodeActionResolve
-> ResolveFunction ideState a 'Method_CodeActionResolve
-> PluginHandlers ideState
forall ideState a (m :: Method 'ClientToServer 'Request).
(FromJSON a, PluginRequestMethod m,
 HasData_ (MessageParams m) (Maybe Value)) =>
SClientMethod m
-> ResolveFunction ideState a m -> PluginHandlers ideState
mkResolveHandler SClientMethod 'Method_CodeActionResolve
SMethod_CodeActionResolve ResolveFunction ideState a 'Method_CodeActionResolve
codeResolveMethod)
  where dropData :: CodeAction -> CodeAction
        dropData :: CodeAction -> CodeAction
dropData CodeAction
ca = CodeAction
ca CodeAction -> (CodeAction -> CodeAction) -> CodeAction
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> CodeAction -> Identity CodeAction
forall s a. HasData_ s a => Lens' s a
Lens' CodeAction (Maybe Value)
L.data_ ((Maybe Value -> Identity (Maybe Value))
 -> CodeAction -> Identity CodeAction)
-> Maybe Value -> CodeAction -> CodeAction
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Value
forall a. Maybe a
Nothing
        resolveCodeAction :: Uri -> ideState -> PluginId -> (Command |? CodeAction) -> ExceptT PluginError (HandlerM Config) (Command |? CodeAction)
        resolveCodeAction :: Uri
-> ideState
-> PluginId
-> (Command |? CodeAction)
-> ExceptT PluginError (HandlerM Config) (Command |? CodeAction)
resolveCodeAction Uri
_uri ideState
_ideState PluginId
_plId c :: Command |? CodeAction
c@(InL Command
_) = (Command |? CodeAction)
-> ExceptT PluginError (HandlerM Config) (Command |? CodeAction)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command |? CodeAction
c
        resolveCodeAction Uri
uri ideState
ideState PluginId
pid (InR codeAction :: CodeAction
codeAction@CodeAction{$sel:_data_:CodeAction :: CodeAction -> Maybe Value
_data_=Just Value
value}) = do
          case Value -> Result a
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
value of
            A.Error String
err -> PluginError
-> ExceptT PluginError (HandlerM Config) (Command |? CodeAction)
forall a. PluginError -> ExceptT PluginError (HandlerM Config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT PluginError (HandlerM Config) (Command |? CodeAction))
-> PluginError
-> ExceptT PluginError (HandlerM Config) (Command |? CodeAction)
forall a b. (a -> b) -> a -> b
$ Maybe Value -> Text -> PluginError
parseError (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
value) (String -> Text
T.pack String
err)
            A.Success a
innerValueDecoded -> do
              CodeAction
resolveResult <- ResolveFunction ideState a 'Method_CodeActionResolve
codeResolveMethod ideState
ideState PluginId
pid MessageParams 'Method_CodeActionResolve
CodeAction
codeAction Uri
uri a
innerValueDecoded
              case CodeAction
resolveResult of
                CodeAction {$sel:_edit:CodeAction :: CodeAction -> Maybe WorkspaceEdit
_edit = Just WorkspaceEdit
_ } -> do
                  (Command |? CodeAction)
-> ExceptT PluginError (HandlerM Config) (Command |? CodeAction)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Command |? CodeAction)
 -> ExceptT PluginError (HandlerM Config) (Command |? CodeAction))
-> (Command |? CodeAction)
-> ExceptT PluginError (HandlerM Config) (Command |? CodeAction)
forall a b. (a -> b) -> a -> b
$ CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> Command |? CodeAction)
-> CodeAction -> Command |? CodeAction
forall a b. (a -> b) -> a -> b
$ CodeAction -> CodeAction
dropData CodeAction
resolveResult
                CodeAction
_ -> PluginError
-> ExceptT PluginError (HandlerM Config) (Command |? CodeAction)
forall a. PluginError -> ExceptT PluginError (HandlerM Config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT PluginError (HandlerM Config) (Command |? CodeAction))
-> PluginError
-> ExceptT PluginError (HandlerM Config) (Command |? CodeAction)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
invalidParamsError Text
"Returned CodeAction has no data field"
        resolveCodeAction Uri
_ ideState
_ PluginId
_ (InR CodeAction{$sel:_data_:CodeAction :: CodeAction -> Maybe Value
_data_=Maybe Value
Nothing}) = PluginError
-> ExceptT PluginError (HandlerM Config) (Command |? CodeAction)
forall a. PluginError -> ExceptT PluginError (HandlerM Config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT PluginError (HandlerM Config) (Command |? CodeAction))
-> PluginError
-> ExceptT PluginError (HandlerM Config) (Command |? CodeAction)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
invalidParamsError Text
"CodeAction has no data field"


-- |When provided with both a codeAction provider with a data field and a resolve
--  provider, this function creates a handler that creates a command that uses
-- your resolve if the client doesn't have code action resolve support. This means
-- you don't have to check whether the client supports resolve and act
-- accordingly in your own providers. see Note [Code action resolve fallback to commands]
-- Also: This helper only works with workspace edits, not commands. Any command set
-- either in the original code action or in the resolve will be ignored.
mkCodeActionWithResolveAndCommand
  :: forall ideState a. (A.FromJSON a) =>
  Recorder (WithPriority Log)
  -> PluginId
  -> PluginMethodHandler ideState 'Method_TextDocumentCodeAction
  -> ResolveFunction ideState a 'Method_CodeActionResolve
  -> ([PluginCommand ideState], PluginHandlers ideState)
mkCodeActionWithResolveAndCommand :: forall ideState a.
FromJSON a =>
Recorder (WithPriority Log)
-> PluginId
-> PluginMethodHandler ideState 'Method_TextDocumentCodeAction
-> ResolveFunction ideState a 'Method_CodeActionResolve
-> ([PluginCommand ideState], PluginHandlers ideState)
mkCodeActionWithResolveAndCommand Recorder (WithPriority Log)
recorder PluginId
plId PluginMethodHandler ideState 'Method_TextDocumentCodeAction
codeActionMethod ResolveFunction ideState a 'Method_CodeActionResolve
codeResolveMethod =
  let newCodeActionMethod :: ideState
-> PluginId
-> CodeActionParams
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
newCodeActionMethod ideState
ideState PluginId
pid CodeActionParams
params =
        do [Command |? CodeAction] |? Null
codeActionReturn <- PluginMethodHandler ideState 'Method_TextDocumentCodeAction
codeActionMethod ideState
ideState PluginId
pid MessageParams 'Method_TextDocumentCodeAction
CodeActionParams
params
           ClientCapabilities
caps <- HandlerM Config ClientCapabilities
-> ExceptT PluginError (HandlerM Config) ClientCapabilities
forall (m :: * -> *) a. Monad m => m a -> ExceptT PluginError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift HandlerM Config ClientCapabilities
forall config. HandlerM config ClientCapabilities
pluginGetClientCapabilities
           case [Command |? CodeAction] |? Null
codeActionReturn of
             r :: [Command |? CodeAction] |? Null
r@(InR Null
Null) -> ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Command |? CodeAction] |? Null
r
             (InL [Command |? CodeAction]
ls) | -- We don't need to do anything if the client supports
                        -- resolve
                        ClientCapabilities -> Bool
supportsCodeActionResolve ClientCapabilities
caps -> ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Command |? CodeAction] |? Null)
 -> ExceptT
      PluginError (HandlerM Config) ([Command |? CodeAction] |? Null))
-> ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
InL [Command |? CodeAction]
ls
                        -- If they do not we will drop the data field, in addition we will populate the command
                        -- field with our command to execute the resolve, with the whole code action as it's argument.
                      | Bool
otherwise -> do
                        Recorder (WithPriority Log)
-> Priority -> Log -> ExceptT PluginError (HandlerM Config) ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Debug (Text -> Log
DoesNotSupportResolve Text
"rewriting the code action to use commands")
                        ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Command |? CodeAction] |? Null)
 -> ExceptT
      PluginError (HandlerM Config) ([Command |? CodeAction] |? Null))
-> ([Command |? CodeAction] |? Null)
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
InL ([Command |? CodeAction] -> [Command |? CodeAction] |? Null)
-> [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. (a -> b) -> a -> b
$ Uri -> (Command |? CodeAction) -> Command |? CodeAction
moveDataToCommand (CodeActionParams
params CodeActionParams -> Getting Uri CodeActionParams Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> CodeActionParams -> Const Uri CodeActionParams
forall s a. HasTextDocument s a => Lens' s a
Lens' CodeActionParams TextDocumentIdentifier
L.textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> CodeActionParams -> Const Uri CodeActionParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> Getting Uri CodeActionParams Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
L.uri) ((Command |? CodeAction) -> Command |? CodeAction)
-> [Command |? CodeAction] -> [Command |? CodeAction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Command |? CodeAction]
ls
  in ([CommandId
-> Text
-> CommandFunction ideState CodeAction
-> PluginCommand ideState
forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand CommandId
"codeActionResolve" Text
"Executes resolve for code action" (ResolveFunction ideState a 'Method_CodeActionResolve
-> CommandFunction ideState CodeAction
executeResolveCmd ResolveFunction ideState a 'Method_CodeActionResolve
codeResolveMethod)],
  SClientMethod 'Method_TextDocumentCodeAction
-> PluginMethodHandler ideState 'Method_TextDocumentCodeAction
-> PluginHandlers ideState
forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction PluginMethodHandler ideState 'Method_TextDocumentCodeAction
ideState
-> PluginId
-> CodeActionParams
-> ExceptT
     PluginError (HandlerM Config) ([Command |? CodeAction] |? Null)
newCodeActionMethod
  PluginHandlers ideState
-> PluginHandlers ideState -> PluginHandlers ideState
forall a. Semigroup a => a -> a -> a
<> SClientMethod 'Method_CodeActionResolve
-> ResolveFunction ideState a 'Method_CodeActionResolve
-> PluginHandlers ideState
forall ideState a (m :: Method 'ClientToServer 'Request).
(FromJSON a, PluginRequestMethod m,
 HasData_ (MessageParams m) (Maybe Value)) =>
SClientMethod m
-> ResolveFunction ideState a m -> PluginHandlers ideState
mkResolveHandler SClientMethod 'Method_CodeActionResolve
SMethod_CodeActionResolve ResolveFunction ideState a 'Method_CodeActionResolve
codeResolveMethod)
  where moveDataToCommand :: Uri -> Command |? CodeAction -> Command |? CodeAction
        moveDataToCommand :: Uri -> (Command |? CodeAction) -> Command |? CodeAction
moveDataToCommand Uri
uri Command |? CodeAction
ca =
          let dat :: Maybe Value
dat = CodeAction -> Value
forall a. ToJSON a => a -> Value
A.toJSON (CodeAction -> Value)
-> (CodeAction -> CodeAction) -> CodeAction -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uri -> CodeAction -> CodeAction
wrapWithURI Uri
uri (CodeAction -> Value) -> Maybe CodeAction -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Command |? CodeAction
ca (Command |? CodeAction)
-> Getting (First CodeAction) (Command |? CodeAction) CodeAction
-> Maybe CodeAction
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First CodeAction) (Command |? CodeAction) CodeAction
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p b (f b) -> p (a |? b) (f (a |? b))
_R -- We need to take the whole codeAction
              -- And put it in the argument for the Command, that way we can later
              -- pass it to the resolve handler (which expects a whole code action)
              -- It should be noted that mkLspCommand already specifies the command
              -- to the plugin, so we don't need to do that here.
              cmd :: Command
cmd = PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
plId (Text -> CommandId
CommandId Text
"codeActionResolve") Text
"Execute Code Action" (Value -> [Value]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> [Value]) -> Maybe Value -> Maybe [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
dat)
          in Command |? CodeAction
ca
              (Command |? CodeAction)
-> ((Command |? CodeAction) -> Command |? CodeAction)
-> Command |? CodeAction
forall a b. a -> (a -> b) -> b
& (CodeAction -> Identity CodeAction)
-> (Command |? CodeAction) -> Identity (Command |? CodeAction)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p b (f b) -> p (a |? b) (f (a |? b))
_R ((CodeAction -> Identity CodeAction)
 -> (Command |? CodeAction) -> Identity (Command |? CodeAction))
-> ((Maybe Value -> Identity (Maybe Value))
    -> CodeAction -> Identity CodeAction)
-> (Maybe Value -> Identity (Maybe Value))
-> (Command |? CodeAction)
-> Identity (Command |? CodeAction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value -> Identity (Maybe Value))
-> CodeAction -> Identity CodeAction
forall s a. HasData_ s a => Lens' s a
Lens' CodeAction (Maybe Value)
L.data_ ((Maybe Value -> Identity (Maybe Value))
 -> (Command |? CodeAction) -> Identity (Command |? CodeAction))
-> Maybe Value -> (Command |? CodeAction) -> Command |? CodeAction
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Value
forall a. Maybe a
Nothing -- Set the data field to nothing
              (Command |? CodeAction)
-> ((Command |? CodeAction) -> Command |? CodeAction)
-> Command |? CodeAction
forall a b. a -> (a -> b) -> b
& (CodeAction -> Identity CodeAction)
-> (Command |? CodeAction) -> Identity (Command |? CodeAction)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p b (f b) -> p (a |? b) (f (a |? b))
_R ((CodeAction -> Identity CodeAction)
 -> (Command |? CodeAction) -> Identity (Command |? CodeAction))
-> ((Maybe Command -> Identity (Maybe Command))
    -> CodeAction -> Identity CodeAction)
-> (Maybe Command -> Identity (Maybe Command))
-> (Command |? CodeAction)
-> Identity (Command |? CodeAction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Command -> Identity (Maybe Command))
-> CodeAction -> Identity CodeAction
forall s a. HasCommand s a => Lens' s a
Lens' CodeAction (Maybe Command)
L.command ((Maybe Command -> Identity (Maybe Command))
 -> (Command |? CodeAction) -> Identity (Command |? CodeAction))
-> Command -> (Command |? CodeAction) -> Command |? CodeAction
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Command
cmd -- And set the command to our previously created command
        wrapWithURI ::  Uri -> CodeAction -> CodeAction
        wrapWithURI :: Uri -> CodeAction -> CodeAction
wrapWithURI  Uri
uri CodeAction
codeAction =
          CodeAction
codeAction CodeAction -> (CodeAction -> CodeAction) -> CodeAction
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> CodeAction -> Identity CodeAction
forall s a. HasData_ s a => Lens' s a
Lens' CodeAction (Maybe Value)
L.data_ ((Maybe Value -> Identity (Maybe Value))
 -> CodeAction -> Identity CodeAction)
-> Maybe Value -> CodeAction -> CodeAction
forall s t a b. ASetter s t a b -> b -> s -> t
.~  (WithURI -> Value
forall a. ToJSON a => a -> Value
A.toJSON (WithURI -> Value) -> (Value -> WithURI) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Uri -> Value -> WithURI
WithURI Uri
uri (Value -> Value) -> Maybe Value -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
data_)
          where data_ :: Maybe Value
data_ = CodeAction
codeAction CodeAction -> Getting (First Value) CodeAction Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe Value -> Const (First Value) (Maybe Value))
-> CodeAction -> Const (First Value) CodeAction
forall s a. HasData_ s a => Lens' s a
Lens' CodeAction (Maybe Value)
L.data_ ((Maybe Value -> Const (First Value) (Maybe Value))
 -> CodeAction -> Const (First Value) CodeAction)
-> ((Value -> Const (First Value) Value)
    -> Maybe Value -> Const (First Value) (Maybe Value))
-> Getting (First Value) CodeAction Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (First Value) Value)
-> Maybe Value -> Const (First Value) (Maybe Value)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just
        executeResolveCmd :: ResolveFunction ideState a 'Method_CodeActionResolve -> CommandFunction ideState CodeAction
        executeResolveCmd :: ResolveFunction ideState a 'Method_CodeActionResolve
-> CommandFunction ideState CodeAction
executeResolveCmd ResolveFunction ideState a 'Method_CodeActionResolve
resolveProvider ideState
ideState Maybe ProgressToken
_token ca :: CodeAction
ca@CodeAction{$sel:_data_:CodeAction :: CodeAction -> Maybe Value
_data_=Just Value
value} = do
          case Value -> Result WithURI
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
value of
            A.Error String
err -> PluginError
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a. PluginError -> ExceptT PluginError (HandlerM Config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT PluginError (HandlerM Config) (Value |? Null))
-> PluginError
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Maybe Value -> Text -> PluginError
parseError (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
value) (String -> Text
T.pack String
err)
            A.Success (WithURI Uri
uri Value
innerValue) -> do
              case Value -> Result a
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
innerValue of
                A.Error String
err -> PluginError
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a. PluginError -> ExceptT PluginError (HandlerM Config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT PluginError (HandlerM Config) (Value |? Null))
-> PluginError
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Maybe Value -> Text -> PluginError
parseError (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
value) (String -> Text
T.pack String
err)
                A.Success a
innerValueDecoded -> do
                  CodeAction
resolveResult <- ResolveFunction ideState a 'Method_CodeActionResolve
resolveProvider ideState
ideState PluginId
plId MessageParams 'Method_CodeActionResolve
CodeAction
ca Uri
uri a
innerValueDecoded
                  case CodeAction
resolveResult of
                    ca2 :: CodeAction
ca2@CodeAction {$sel:_edit:CodeAction :: CodeAction -> Maybe WorkspaceEdit
_edit = Just WorkspaceEdit
wedits } | CodeAction -> CodeAction -> [Text]
diffCodeActions CodeAction
ca CodeAction
ca2 [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text
"edit"] -> do
                        LspId 'Method_WorkspaceApplyEdit
_ <- HandlerM
  Config (Either PluginError (LspId 'Method_WorkspaceApplyEdit))
-> ExceptT
     PluginError (HandlerM Config) (LspId 'Method_WorkspaceApplyEdit)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (HandlerM
   Config (Either PluginError (LspId 'Method_WorkspaceApplyEdit))
 -> ExceptT
      PluginError (HandlerM Config) (LspId 'Method_WorkspaceApplyEdit))
-> HandlerM
     Config (Either PluginError (LspId 'Method_WorkspaceApplyEdit))
-> ExceptT
     PluginError (HandlerM Config) (LspId 'Method_WorkspaceApplyEdit)
forall a b. (a -> b) -> a -> b
$ LspId 'Method_WorkspaceApplyEdit
-> Either PluginError (LspId 'Method_WorkspaceApplyEdit)
forall a b. b -> Either a b
Right (LspId 'Method_WorkspaceApplyEdit
 -> Either PluginError (LspId 'Method_WorkspaceApplyEdit))
-> HandlerM Config (LspId 'Method_WorkspaceApplyEdit)
-> HandlerM
     Config (Either PluginError (LspId 'Method_WorkspaceApplyEdit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> (Either
      (TResponseError 'Method_WorkspaceApplyEdit)
      (MessageResult 'Method_WorkspaceApplyEdit)
    -> HandlerM Config ())
-> HandlerM Config (LspId 'Method_WorkspaceApplyEdit)
forall (m :: Method 'ServerToClient 'Request) config.
SServerMethod m
-> MessageParams m
-> (Either (TResponseError m) (MessageResult m)
    -> HandlerM config ())
-> HandlerM config (LspId m)
pluginSendRequest SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
wedits) Either
  (TResponseError 'Method_WorkspaceApplyEdit)
  (MessageResult 'Method_WorkspaceApplyEdit)
-> HandlerM Config ()
Either
  (TResponseError 'Method_WorkspaceApplyEdit)
  ApplyWorkspaceEditResult
-> HandlerM Config ()
forall {f :: MessageDirection} {m :: * -> *}
       {m :: Method f 'Request} {b}.
(MonadIO m, ToJSON (ErrorData m)) =>
Either (TResponseError m) b -> m ()
handleWEditCallback
                        (Value |? Null)
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Value |? Null)
 -> ExceptT PluginError (HandlerM Config) (Value |? Null))
-> (Value |? Null)
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Null -> Value |? Null
forall a b. b -> a |? b
InR Null
Null
                    ca2 :: CodeAction
ca2@CodeAction {$sel:_edit:CodeAction :: CodeAction -> Maybe WorkspaceEdit
_edit = Just WorkspaceEdit
_ }  ->
                      PluginError
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a. PluginError -> ExceptT PluginError (HandlerM Config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT PluginError (HandlerM Config) (Value |? Null))
-> PluginError
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
internalError (Text -> PluginError) -> Text -> PluginError
forall a b. (a -> b) -> a -> b
$
                          Text
"The resolve provider unexpectedly returned a code action with the following differing fields: "
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> String
forall a. Show a => a -> String
show ([Text] -> String) -> [Text] -> String
forall a b. (a -> b) -> a -> b
$  CodeAction -> CodeAction -> [Text]
diffCodeActions CodeAction
ca CodeAction
ca2)
                    CodeAction
_ -> PluginError
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a. PluginError -> ExceptT PluginError (HandlerM Config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT PluginError (HandlerM Config) (Value |? Null))
-> PluginError
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
internalError Text
"The resolve provider unexpectedly returned a result with no data field"
        executeResolveCmd ResolveFunction ideState a 'Method_CodeActionResolve
_ ideState
_ Maybe ProgressToken
_ CodeAction{$sel:_data_:CodeAction :: CodeAction -> Maybe Value
_data_= Maybe Value
value} = PluginError
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a. PluginError -> ExceptT PluginError (HandlerM Config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT PluginError (HandlerM Config) (Value |? Null))
-> PluginError
-> ExceptT PluginError (HandlerM Config) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
invalidParamsError (Text
"The code action to resolve has an illegal data field: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Value -> String
forall a. Show a => a -> String
show Maybe Value
value))
        handleWEditCallback :: Either (TResponseError m) b -> m ()
handleWEditCallback (Left TResponseError m
err ) = do
            Recorder (WithPriority Log) -> Priority -> Log -> m ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning (TResponseError m -> Log
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseError m -> Log
ApplyWorkspaceEditFailed TResponseError m
err)
            () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        handleWEditCallback Either (TResponseError m) b
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- TODO: Remove once provided by lsp-types
-- |Compares two CodeActions and returns a list of fields that are not equal
diffCodeActions :: CodeAction -> CodeAction -> [T.Text]
diffCodeActions :: CodeAction -> CodeAction -> [Text]
diffCodeActions CodeAction
ca CodeAction
ca2 =
  let titleDiff :: Maybe Text
titleDiff = if CodeAction
ca CodeAction -> Getting Text CodeAction Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text CodeAction Text
forall s a. HasTitle s a => Lens' s a
Lens' CodeAction Text
L.title Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 CodeAction -> Getting Text CodeAction Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text CodeAction Text
forall s a. HasTitle s a => Lens' s a
Lens' CodeAction Text
L.title then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"title"
      kindDiff :: Maybe Text
kindDiff = if CodeAction
ca CodeAction
-> Getting (Maybe CodeActionKind) CodeAction (Maybe CodeActionKind)
-> Maybe CodeActionKind
forall s a. s -> Getting a s a -> a
^. Getting (Maybe CodeActionKind) CodeAction (Maybe CodeActionKind)
forall s a. HasKind s a => Lens' s a
Lens' CodeAction (Maybe CodeActionKind)
L.kind Maybe CodeActionKind -> Maybe CodeActionKind -> Bool
forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 CodeAction
-> Getting (Maybe CodeActionKind) CodeAction (Maybe CodeActionKind)
-> Maybe CodeActionKind
forall s a. s -> Getting a s a -> a
^. Getting (Maybe CodeActionKind) CodeAction (Maybe CodeActionKind)
forall s a. HasKind s a => Lens' s a
Lens' CodeAction (Maybe CodeActionKind)
L.kind then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"kind"
      diagnosticsDiff :: Maybe Text
diagnosticsDiff = if CodeAction
ca CodeAction
-> Getting (Maybe [Diagnostic]) CodeAction (Maybe [Diagnostic])
-> Maybe [Diagnostic]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [Diagnostic]) CodeAction (Maybe [Diagnostic])
forall s a. HasDiagnostics s a => Lens' s a
Lens' CodeAction (Maybe [Diagnostic])
L.diagnostics Maybe [Diagnostic] -> Maybe [Diagnostic] -> Bool
forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 CodeAction
-> Getting (Maybe [Diagnostic]) CodeAction (Maybe [Diagnostic])
-> Maybe [Diagnostic]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [Diagnostic]) CodeAction (Maybe [Diagnostic])
forall s a. HasDiagnostics s a => Lens' s a
Lens' CodeAction (Maybe [Diagnostic])
L.diagnostics then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"diagnostics"
      commandDiff :: Maybe Text
commandDiff = if CodeAction
ca CodeAction
-> Getting (Maybe Command) CodeAction (Maybe Command)
-> Maybe Command
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Command) CodeAction (Maybe Command)
forall s a. HasCommand s a => Lens' s a
Lens' CodeAction (Maybe Command)
L.command Maybe Command -> Maybe Command -> Bool
forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 CodeAction
-> Getting (Maybe Command) CodeAction (Maybe Command)
-> Maybe Command
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Command) CodeAction (Maybe Command)
forall s a. HasCommand s a => Lens' s a
Lens' CodeAction (Maybe Command)
L.command then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"diagnostics"
      isPreferredDiff :: Maybe Text
isPreferredDiff = if CodeAction
ca CodeAction
-> Getting (Maybe Bool) CodeAction (Maybe Bool) -> Maybe Bool
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Bool) CodeAction (Maybe Bool)
forall s a. HasIsPreferred s a => Lens' s a
Lens' CodeAction (Maybe Bool)
L.isPreferred Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 CodeAction
-> Getting (Maybe Bool) CodeAction (Maybe Bool) -> Maybe Bool
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Bool) CodeAction (Maybe Bool)
forall s a. HasIsPreferred s a => Lens' s a
Lens' CodeAction (Maybe Bool)
L.isPreferred then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"isPreferred"
      dataDiff :: Maybe Text
dataDiff = if CodeAction
ca CodeAction
-> Getting (Maybe Value) CodeAction (Maybe Value) -> Maybe Value
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Value) CodeAction (Maybe Value)
forall s a. HasData_ s a => Lens' s a
Lens' CodeAction (Maybe Value)
L.data_ Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 CodeAction
-> Getting (Maybe Value) CodeAction (Maybe Value) -> Maybe Value
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Value) CodeAction (Maybe Value)
forall s a. HasData_ s a => Lens' s a
Lens' CodeAction (Maybe Value)
L.data_ then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"data"
      disabledDiff :: Maybe Text
disabledDiff = if CodeAction
ca CodeAction
-> Getting
     (Maybe CodeActionDisabled) CodeAction (Maybe CodeActionDisabled)
-> Maybe CodeActionDisabled
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe CodeActionDisabled) CodeAction (Maybe CodeActionDisabled)
forall s a. HasDisabled s a => Lens' s a
Lens' CodeAction (Maybe CodeActionDisabled)
L.disabled Maybe CodeActionDisabled -> Maybe CodeActionDisabled -> Bool
forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 CodeAction
-> Getting
     (Maybe CodeActionDisabled) CodeAction (Maybe CodeActionDisabled)
-> Maybe CodeActionDisabled
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe CodeActionDisabled) CodeAction (Maybe CodeActionDisabled)
forall s a. HasDisabled s a => Lens' s a
Lens' CodeAction (Maybe CodeActionDisabled)
L.disabled then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"disabled"
      editDiff :: Maybe Text
editDiff = if CodeAction
ca CodeAction
-> Getting (Maybe WorkspaceEdit) CodeAction (Maybe WorkspaceEdit)
-> Maybe WorkspaceEdit
forall s a. s -> Getting a s a -> a
^. Getting (Maybe WorkspaceEdit) CodeAction (Maybe WorkspaceEdit)
forall s a. HasEdit s a => Lens' s a
Lens' CodeAction (Maybe WorkspaceEdit)
L.edit Maybe WorkspaceEdit -> Maybe WorkspaceEdit -> Bool
forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 CodeAction
-> Getting (Maybe WorkspaceEdit) CodeAction (Maybe WorkspaceEdit)
-> Maybe WorkspaceEdit
forall s a. s -> Getting a s a -> a
^. Getting (Maybe WorkspaceEdit) CodeAction (Maybe WorkspaceEdit)
forall s a. HasEdit s a => Lens' s a
Lens' CodeAction (Maybe WorkspaceEdit)
L.edit then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"edit"
  in [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text
titleDiff, Maybe Text
kindDiff, Maybe Text
diagnosticsDiff, Maybe Text
commandDiff, Maybe Text
isPreferredDiff, Maybe Text
dataDiff, Maybe Text
disabledDiff, Maybe Text
editDiff]

-- |To execute the resolve provider as a command, we need to additionally store
-- the URI that was provided to the original code action.
data WithURI = WithURI {
 WithURI -> Uri
_uri    :: Uri
, WithURI -> Value
_value :: A.Value
} deriving ((forall x. WithURI -> Rep WithURI x)
-> (forall x. Rep WithURI x -> WithURI) -> Generic WithURI
forall x. Rep WithURI x -> WithURI
forall x. WithURI -> Rep WithURI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WithURI -> Rep WithURI x
from :: forall x. WithURI -> Rep WithURI x
$cto :: forall x. Rep WithURI x -> WithURI
to :: forall x. Rep WithURI x -> WithURI
Generic, Int -> WithURI -> ShowS
[WithURI] -> ShowS
WithURI -> String
(Int -> WithURI -> ShowS)
-> (WithURI -> String) -> ([WithURI] -> ShowS) -> Show WithURI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WithURI -> ShowS
showsPrec :: Int -> WithURI -> ShowS
$cshow :: WithURI -> String
show :: WithURI -> String
$cshowList :: [WithURI] -> ShowS
showList :: [WithURI] -> ShowS
Show)
instance A.ToJSON WithURI
instance A.FromJSON WithURI

-- |Checks if the the client supports resolve for code action. We currently only check
--  whether resolve for the edit field is supported, because that's the only one we care
-- about at the moment.
supportsCodeActionResolve :: ClientCapabilities -> Bool
supportsCodeActionResolve :: ClientCapabilities -> Bool
supportsCodeActionResolve ClientCapabilities
caps =
    ClientCapabilities
caps ClientCapabilities
-> Getting (First Bool) ClientCapabilities Bool -> Maybe Bool
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe TextDocumentClientCapabilities
 -> Const (First Bool) (Maybe TextDocumentClientCapabilities))
-> ClientCapabilities -> Const (First Bool) ClientCapabilities
forall s a. HasTextDocument s a => Lens' s a
Lens' ClientCapabilities (Maybe TextDocumentClientCapabilities)
L.textDocument ((Maybe TextDocumentClientCapabilities
  -> Const (First Bool) (Maybe TextDocumentClientCapabilities))
 -> ClientCapabilities -> Const (First Bool) ClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
    -> Maybe TextDocumentClientCapabilities
    -> Const (First Bool) (Maybe TextDocumentClientCapabilities))
-> Getting (First Bool) ClientCapabilities Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentClientCapabilities
 -> Const (First Bool) TextDocumentClientCapabilities)
-> Maybe TextDocumentClientCapabilities
-> Const (First Bool) (Maybe TextDocumentClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((TextDocumentClientCapabilities
  -> Const (First Bool) TextDocumentClientCapabilities)
 -> Maybe TextDocumentClientCapabilities
 -> Const (First Bool) (Maybe TextDocumentClientCapabilities))
-> ((Bool -> Const (First Bool) Bool)
    -> TextDocumentClientCapabilities
    -> Const (First Bool) TextDocumentClientCapabilities)
-> (Bool -> Const (First Bool) Bool)
-> Maybe TextDocumentClientCapabilities
-> Const (First Bool) (Maybe TextDocumentClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe CodeActionClientCapabilities
 -> Const (First Bool) (Maybe CodeActionClientCapabilities))
-> TextDocumentClientCapabilities
-> Const (First Bool) TextDocumentClientCapabilities
forall s a. HasCodeAction s a => Lens' s a
Lens'
  TextDocumentClientCapabilities (Maybe CodeActionClientCapabilities)
L.codeAction ((Maybe CodeActionClientCapabilities
  -> Const (First Bool) (Maybe CodeActionClientCapabilities))
 -> TextDocumentClientCapabilities
 -> Const (First Bool) TextDocumentClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
    -> Maybe CodeActionClientCapabilities
    -> Const (First Bool) (Maybe CodeActionClientCapabilities))
-> (Bool -> Const (First Bool) Bool)
-> TextDocumentClientCapabilities
-> Const (First Bool) TextDocumentClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeActionClientCapabilities
 -> Const (First Bool) CodeActionClientCapabilities)
-> Maybe CodeActionClientCapabilities
-> Const (First Bool) (Maybe CodeActionClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((CodeActionClientCapabilities
  -> Const (First Bool) CodeActionClientCapabilities)
 -> Maybe CodeActionClientCapabilities
 -> Const (First Bool) (Maybe CodeActionClientCapabilities))
-> ((Bool -> Const (First Bool) Bool)
    -> CodeActionClientCapabilities
    -> Const (First Bool) CodeActionClientCapabilities)
-> (Bool -> Const (First Bool) Bool)
-> Maybe CodeActionClientCapabilities
-> Const (First Bool) (Maybe CodeActionClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Const (First Bool) (Maybe Bool))
-> CodeActionClientCapabilities
-> Const (First Bool) CodeActionClientCapabilities
forall s a. HasDataSupport s a => Lens' s a
Lens' CodeActionClientCapabilities (Maybe Bool)
L.dataSupport ((Maybe Bool -> Const (First Bool) (Maybe Bool))
 -> CodeActionClientCapabilities
 -> Const (First Bool) CodeActionClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
    -> Maybe Bool -> Const (First Bool) (Maybe Bool))
-> (Bool -> Const (First Bool) Bool)
-> CodeActionClientCapabilities
-> Const (First Bool) CodeActionClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const (First Bool) Bool)
-> Maybe Bool -> Const (First Bool) (Maybe Bool)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    Bool -> Bool -> Bool
&& case ClientCapabilities
caps ClientCapabilities
-> Getting
     (First ClientCodeActionResolveOptions)
     ClientCapabilities
     ClientCodeActionResolveOptions
-> Maybe ClientCodeActionResolveOptions
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe TextDocumentClientCapabilities
 -> Const
      (First ClientCodeActionResolveOptions)
      (Maybe TextDocumentClientCapabilities))
-> ClientCapabilities
-> Const (First ClientCodeActionResolveOptions) ClientCapabilities
forall s a. HasTextDocument s a => Lens' s a
Lens' ClientCapabilities (Maybe TextDocumentClientCapabilities)
L.textDocument ((Maybe TextDocumentClientCapabilities
  -> Const
       (First ClientCodeActionResolveOptions)
       (Maybe TextDocumentClientCapabilities))
 -> ClientCapabilities
 -> Const (First ClientCodeActionResolveOptions) ClientCapabilities)
-> ((ClientCodeActionResolveOptions
     -> Const
          (First ClientCodeActionResolveOptions)
          ClientCodeActionResolveOptions)
    -> Maybe TextDocumentClientCapabilities
    -> Const
         (First ClientCodeActionResolveOptions)
         (Maybe TextDocumentClientCapabilities))
-> Getting
     (First ClientCodeActionResolveOptions)
     ClientCapabilities
     ClientCodeActionResolveOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentClientCapabilities
 -> Const
      (First ClientCodeActionResolveOptions)
      TextDocumentClientCapabilities)
-> Maybe TextDocumentClientCapabilities
-> Const
     (First ClientCodeActionResolveOptions)
     (Maybe TextDocumentClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((TextDocumentClientCapabilities
  -> Const
       (First ClientCodeActionResolveOptions)
       TextDocumentClientCapabilities)
 -> Maybe TextDocumentClientCapabilities
 -> Const
      (First ClientCodeActionResolveOptions)
      (Maybe TextDocumentClientCapabilities))
-> ((ClientCodeActionResolveOptions
     -> Const
          (First ClientCodeActionResolveOptions)
          ClientCodeActionResolveOptions)
    -> TextDocumentClientCapabilities
    -> Const
         (First ClientCodeActionResolveOptions)
         TextDocumentClientCapabilities)
-> (ClientCodeActionResolveOptions
    -> Const
         (First ClientCodeActionResolveOptions)
         ClientCodeActionResolveOptions)
-> Maybe TextDocumentClientCapabilities
-> Const
     (First ClientCodeActionResolveOptions)
     (Maybe TextDocumentClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe CodeActionClientCapabilities
 -> Const
      (First ClientCodeActionResolveOptions)
      (Maybe CodeActionClientCapabilities))
-> TextDocumentClientCapabilities
-> Const
     (First ClientCodeActionResolveOptions)
     TextDocumentClientCapabilities
forall s a. HasCodeAction s a => Lens' s a
Lens'
  TextDocumentClientCapabilities (Maybe CodeActionClientCapabilities)
L.codeAction ((Maybe CodeActionClientCapabilities
  -> Const
       (First ClientCodeActionResolveOptions)
       (Maybe CodeActionClientCapabilities))
 -> TextDocumentClientCapabilities
 -> Const
      (First ClientCodeActionResolveOptions)
      TextDocumentClientCapabilities)
-> ((ClientCodeActionResolveOptions
     -> Const
          (First ClientCodeActionResolveOptions)
          ClientCodeActionResolveOptions)
    -> Maybe CodeActionClientCapabilities
    -> Const
         (First ClientCodeActionResolveOptions)
         (Maybe CodeActionClientCapabilities))
-> (ClientCodeActionResolveOptions
    -> Const
         (First ClientCodeActionResolveOptions)
         ClientCodeActionResolveOptions)
-> TextDocumentClientCapabilities
-> Const
     (First ClientCodeActionResolveOptions)
     TextDocumentClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeActionClientCapabilities
 -> Const
      (First ClientCodeActionResolveOptions)
      CodeActionClientCapabilities)
-> Maybe CodeActionClientCapabilities
-> Const
     (First ClientCodeActionResolveOptions)
     (Maybe CodeActionClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((CodeActionClientCapabilities
  -> Const
       (First ClientCodeActionResolveOptions)
       CodeActionClientCapabilities)
 -> Maybe CodeActionClientCapabilities
 -> Const
      (First ClientCodeActionResolveOptions)
      (Maybe CodeActionClientCapabilities))
-> ((ClientCodeActionResolveOptions
     -> Const
          (First ClientCodeActionResolveOptions)
          ClientCodeActionResolveOptions)
    -> CodeActionClientCapabilities
    -> Const
         (First ClientCodeActionResolveOptions)
         CodeActionClientCapabilities)
-> (ClientCodeActionResolveOptions
    -> Const
         (First ClientCodeActionResolveOptions)
         ClientCodeActionResolveOptions)
-> Maybe CodeActionClientCapabilities
-> Const
     (First ClientCodeActionResolveOptions)
     (Maybe CodeActionClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ClientCodeActionResolveOptions
 -> Const
      (First ClientCodeActionResolveOptions)
      (Maybe ClientCodeActionResolveOptions))
-> CodeActionClientCapabilities
-> Const
     (First ClientCodeActionResolveOptions) CodeActionClientCapabilities
forall s a. HasResolveSupport s a => Lens' s a
Lens'
  CodeActionClientCapabilities (Maybe ClientCodeActionResolveOptions)
L.resolveSupport ((Maybe ClientCodeActionResolveOptions
  -> Const
       (First ClientCodeActionResolveOptions)
       (Maybe ClientCodeActionResolveOptions))
 -> CodeActionClientCapabilities
 -> Const
      (First ClientCodeActionResolveOptions)
      CodeActionClientCapabilities)
-> ((ClientCodeActionResolveOptions
     -> Const
          (First ClientCodeActionResolveOptions)
          ClientCodeActionResolveOptions)
    -> Maybe ClientCodeActionResolveOptions
    -> Const
         (First ClientCodeActionResolveOptions)
         (Maybe ClientCodeActionResolveOptions))
-> (ClientCodeActionResolveOptions
    -> Const
         (First ClientCodeActionResolveOptions)
         ClientCodeActionResolveOptions)
-> CodeActionClientCapabilities
-> Const
     (First ClientCodeActionResolveOptions) CodeActionClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientCodeActionResolveOptions
 -> Const
      (First ClientCodeActionResolveOptions)
      ClientCodeActionResolveOptions)
-> Maybe ClientCodeActionResolveOptions
-> Const
     (First ClientCodeActionResolveOptions)
     (Maybe ClientCodeActionResolveOptions)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just of
        Just ClientCodeActionResolveOptions{[Text]
_properties :: [Text]
$sel:_properties:ClientCodeActionResolveOptions :: ClientCodeActionResolveOptions -> [Text]
_properties} -> Text
"edit" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
_properties
        Maybe ClientCodeActionResolveOptions
_        -> Bool
False

internalError :: T.Text -> PluginError
internalError :: Text -> PluginError
internalError Text
msg = Text -> PluginError
PluginInternalError (Text
"Ide.Plugin.Resolve: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg)

invalidParamsError :: T.Text -> PluginError
invalidParamsError :: Text -> PluginError
invalidParamsError Text
msg = Text -> PluginError
PluginInvalidParams (Text
"Ide.Plugin.Resolve: : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg)

parseError :: Maybe A.Value -> T.Text -> PluginError
parseError :: Maybe Value -> Text -> PluginError
parseError Maybe Value
value Text
errMsg = Text -> PluginError
PluginInternalError (Text
"Ide.Plugin.Resolve: Error parsing value:"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Value -> String
forall a. Show a => a -> String
show Maybe Value
value) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
errMsg)

{- Note [Code action resolve fallback to commands]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  To make supporting code action resolve easy for plugins, we want to let them
  provide one implementation that can be used both when clients support
  resolve, and when they don't.
  The way we do this is to have them always implement a resolve handler.
  Then, if the client doesn't support resolve, we instead install the resolve
  handler as a _command_ handler, passing the code action literal itself
  as the command argument. This allows the command handler to have
  the same interface as the resolve handler!
  -}