{-# LANGUAGE DeriveGeneric            #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE LambdaCase               #-}
{-# LANGUAGE NamedFieldPuns           #-}
{-# LANGUAGE OverloadedLabels         #-}
{-# LANGUAGE OverloadedStrings        #-}
{-# LANGUAGE RankNTypes               #-}
{-# LANGUAGE ScopedTypeVariables      #-}
{-| 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 (..), runExceptT)

import qualified Data.Aeson                    as A
import           Data.Maybe                    (catMaybes)
import           Data.Row                      ((.!))
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
import           Language.LSP.Server           (LspT,
                                                ProgressCancellable (Cancellable),
                                                getClientCapabilities,
                                                sendRequest,
                                                withIndefiniteProgress)

data Log
    = DoesNotSupportResolve T.Text
    | ApplyWorkspaceEditFailed ResponseError
instance Pretty Log where
    pretty :: forall ann. Log -> Doc ann
pretty = \case
        DoesNotSupportResolve Text
fallback->
            Doc ann
"Client does not support resolve," forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
fallback
        ApplyWorkspaceEditFailed ResponseError
err ->
            Doc ann
"ApplyWorkspaceEditFailed:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ResponseError
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 (LspT Config IO) ([Command |? CodeAction] |? Null)
newCodeActionMethod ideState
ideState PluginId
pid CodeActionParams
params =
        do [Command |? CodeAction] |? Null
codeActionReturn <- PluginMethodHandler ideState 'Method_TextDocumentCodeAction
codeActionMethod ideState
ideState PluginId
pid CodeActionParams
params
           ClientCapabilities
caps <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
           case [Command |? CodeAction] |? Null
codeActionReturn of
             r :: [Command |? CodeAction] |? Null
r@(InR Null
Null) -> 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
                        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")
                        forall a b. a -> a |? b
InL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Uri
-> ideState
-> PluginId
-> (Command |? CodeAction)
-> ExceptT PluginError (LspT Config IO) (Command |? CodeAction)
resolveCodeAction (CodeActionParams
params forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
L.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
L.uri) ideState
ideState PluginId
pid) [Command |? CodeAction]
ls
  in (forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction ideState
-> PluginId
-> CodeActionParams
-> ExceptT
     PluginError (LspT Config IO) ([Command |? CodeAction] |? Null)
newCodeActionMethod
  forall a. Semigroup a => a -> a -> a
<> 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 SMethod 'Method_CodeActionResolve
SMethod_CodeActionResolve ResolveFunction ideState a 'Method_CodeActionResolve
codeResolveMethod)
  where dropData :: CodeAction -> CodeAction
        dropData :: CodeAction -> CodeAction
dropData CodeAction
ca = CodeAction
ca forall a b. a -> (a -> b) -> b
& forall s a. HasData_ s a => Lens' s a
L.data_ forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
        resolveCodeAction :: Uri -> ideState -> PluginId -> (Command |? CodeAction) -> ExceptT PluginError (LspT Config IO) (Command |? CodeAction)
        resolveCodeAction :: Uri
-> ideState
-> PluginId
-> (Command |? CodeAction)
-> ExceptT PluginError (LspT Config IO) (Command |? CodeAction)
resolveCodeAction Uri
_uri ideState
_ideState PluginId
_plId c :: Command |? CodeAction
c@(InL Command
_) = 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 forall a. FromJSON a => Value -> Result a
A.fromJSON Value
value of
            A.Error String
err -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Maybe Value -> Text -> PluginError
parseError (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 CodeAction
codeAction Uri
uri a
innerValueDecoded
              case CodeAction
resolveResult of
                CodeAction {$sel:_edit:CodeAction :: CodeAction -> Maybe WorkspaceEdit
_edit = Just WorkspaceEdit
_ } -> do
                  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ CodeAction -> CodeAction
dropData CodeAction
resolveResult
                CodeAction
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError 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}) = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError 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 (LspT Config IO) ([Command |? CodeAction] |? Null)
newCodeActionMethod ideState
ideState PluginId
pid CodeActionParams
params =
        do [Command |? CodeAction] |? Null
codeActionReturn <- PluginMethodHandler ideState 'Method_TextDocumentCodeAction
codeActionMethod ideState
ideState PluginId
pid CodeActionParams
params
           ClientCapabilities
caps <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
           case [Command |? CodeAction] |? Null
codeActionReturn of
             r :: [Command |? CodeAction] |? Null
r@(InR Null
Null) -> 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
                        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")
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ Uri -> (Command |? CodeAction) -> Command |? CodeAction
moveDataToCommand (CodeActionParams
params forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
L.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
L.uri) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Command |? CodeAction]
ls
  in ([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)],
  forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction ideState
-> PluginId
-> CodeActionParams
-> ExceptT
     PluginError (LspT Config IO) ([Command |? CodeAction] |? Null)
newCodeActionMethod
  forall a. Semigroup a => a -> a -> a
<> 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 SMethod '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 = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uri -> CodeAction -> CodeAction
wrapWithURI Uri
uri forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Command |? CodeAction
ca forall s a. s -> Getting (First a) s a -> Maybe a
^? forall a b. Prism' (a |? b) 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" (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
dat)
          in Command |? CodeAction
ca
              forall a b. a -> (a -> b) -> b
& forall a b. Prism' (a |? b) b
_R forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasData_ s a => Lens' s a
L.data_ forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing -- Set the data field to nothing
              forall a b. a -> (a -> b) -> b
& forall a b. Prism' (a |? b) b
_R forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCommand s a => Lens' s a
L.command 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 forall a b. a -> (a -> b) -> b
& forall s a. HasData_ s a => Lens' s a
L.data_ forall s t a b. ASetter s t a b -> b -> s -> t
.~  (forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
.Uri -> Value -> WithURI
WithURI Uri
uri forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
data_)
          where data_ :: Maybe Value
data_ = CodeAction
codeAction forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasData_ s a => Lens' s a
L.data_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a 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 ca :: CodeAction
ca@CodeAction{$sel:_data_:CodeAction :: CodeAction -> Maybe Value
_data_=Just Value
value} = do
          forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *) a.
MonadLsp c m =>
Text -> ProgressCancellable -> m a -> m a
withIndefiniteProgress Text
"Applying edits for code action..." ProgressCancellable
Cancellable forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
            case forall a. FromJSON a => Value -> Result a
A.fromJSON Value
value of
              A.Error String
err -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Maybe Value -> Text -> PluginError
parseError (forall a. a -> Maybe a
Just Value
value) (String -> Text
T.pack String
err)
              A.Success (WithURI Uri
uri Value
innerValue) -> do
                case forall a. FromJSON a => Value -> Result a
A.fromJSON Value
innerValue of
                  A.Error String
err -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Maybe Value -> Text -> PluginError
parseError (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 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 forall a. Eq a => a -> a -> Bool
== [Text
"edit"] -> do
                          LspId 'Method_WorkspaceApplyEdit
_ <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'ServerToClient 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (MessageResult m) -> f ())
-> f (LspId m)
sendRequest SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
wedits) forall {m :: * -> *} {b}.
MonadIO m =>
Either ResponseError b -> m ()
handleWEditCallback
                          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> a |? b
InR Null
Null
                      ca2 :: CodeAction
ca2@CodeAction {$sel:_edit:CodeAction :: CodeAction -> Maybe WorkspaceEdit
_edit = Just WorkspaceEdit
_ }  ->
                        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PluginError
internalError forall a b. (a -> b) -> a -> b
$
                            Text
"The resolve provider unexpectedly returned a code action with the following differing fields: "
                            forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$  CodeAction -> CodeAction -> [Text]
diffCodeActions CodeAction
ca CodeAction
ca2)
                      CodeAction
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError 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
_ CodeAction{$sel:_data_:CodeAction :: CodeAction -> Maybe Value
_data_= Maybe Value
value} = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PluginError
invalidParamsError (Text
"The code action to resolve has an illegal data field: " forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Maybe Value
value))
        handleWEditCallback :: Either ResponseError b -> m ()
handleWEditCallback (Left ResponseError
err ) = do
            forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning (ResponseError -> Log
ApplyWorkspaceEditFailed ResponseError
err)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        handleWEditCallback Either ResponseError b
_ = 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasTitle s a => Lens' s a
L.title forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 forall s a. s -> Getting a s a -> a
^. forall s a. HasTitle s a => Lens' s a
L.title then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Text
"title"
      kindDiff :: Maybe Text
kindDiff = if CodeAction
ca forall s a. s -> Getting a s a -> a
^. forall s a. HasKind s a => Lens' s a
L.kind forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 forall s a. s -> Getting a s a -> a
^. forall s a. HasKind s a => Lens' s a
L.kind then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Text
"kind"
      diagnosticsDiff :: Maybe Text
diagnosticsDiff = if CodeAction
ca forall s a. s -> Getting a s a -> a
^. forall s a. HasDiagnostics s a => Lens' s a
L.diagnostics forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 forall s a. s -> Getting a s a -> a
^. forall s a. HasDiagnostics s a => Lens' s a
L.diagnostics then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Text
"diagnostics"
      commandDiff :: Maybe Text
commandDiff = if CodeAction
ca forall s a. s -> Getting a s a -> a
^. forall s a. HasCommand s a => Lens' s a
L.command forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 forall s a. s -> Getting a s a -> a
^. forall s a. HasCommand s a => Lens' s a
L.command then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Text
"diagnostics"
      isPreferredDiff :: Maybe Text
isPreferredDiff = if CodeAction
ca forall s a. s -> Getting a s a -> a
^. forall s a. HasIsPreferred s a => Lens' s a
L.isPreferred forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 forall s a. s -> Getting a s a -> a
^. forall s a. HasIsPreferred s a => Lens' s a
L.isPreferred then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Text
"isPreferred"
      dataDiff :: Maybe Text
dataDiff = if CodeAction
ca forall s a. s -> Getting a s a -> a
^. forall s a. HasData_ s a => Lens' s a
L.data_ forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 forall s a. s -> Getting a s a -> a
^. forall s a. HasData_ s a => Lens' s a
L.data_ then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Text
"data"
      disabledDiff :: Maybe Text
disabledDiff = if CodeAction
ca forall s a. s -> Getting a s a -> a
^. forall s a. HasDisabled s a => Lens' s a
L.disabled forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 forall s a. s -> Getting a s a -> a
^. forall s a. HasDisabled s a => Lens' s a
L.disabled then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Text
"disabled"
      editDiff :: Maybe Text
editDiff = if CodeAction
ca forall s a. s -> Getting a s a -> a
^. forall s a. HasEdit s a => Lens' s a
L.edit forall a. Eq a => a -> a -> Bool
== CodeAction
ca2 forall s a. s -> Getting a s a -> a
^. forall s a. HasEdit s a => Lens' s a
L.edit then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Text
"edit"
  in 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. 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
$cto :: forall x. Rep WithURI x -> WithURI
$cfrom :: forall x. WithURI -> Rep WithURI x
Generic, Int -> WithURI -> ShowS
[WithURI] -> ShowS
WithURI -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithURI] -> ShowS
$cshowList :: [WithURI] -> ShowS
show :: WithURI -> String
$cshow :: WithURI -> String
showsPrec :: Int -> WithURI -> ShowS
$cshowsPrec :: Int -> 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 forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
L.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCodeAction s a => Lens' s a
L.codeAction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDataSupport s a => Lens' s a
L.dataSupport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
    Bool -> Bool -> Bool
&& case ClientCapabilities
caps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
L.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCodeAction s a => Lens' s a
L.codeAction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasResolveSupport s a => Lens' s a
L.resolveSupport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just of
        Just Rec ('R '[ "properties" ':-> [Text]])
row -> Text
"edit" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Rec ('R '[ "properties" ':-> [Text]])
row forall (l :: Symbol) (r :: Row (*)).
KnownSymbol l =>
Rec r -> Label l -> r .! l
.! forall a. IsLabel "properties" a => a
#properties
        Maybe (Rec ('R '[ "properties" ':-> [Text]]))
_        -> Bool
False

internalError :: T.Text -> PluginError
internalError :: Text -> PluginError
internalError Text
msg = Text -> PluginError
PluginInternalError (Text
"Ide.Plugin.Resolve: " 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: : " 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:"forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Maybe Value
value) forall a. Semigroup a => a -> a -> a
<> Text
" Error: "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!
  -}