{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}
module Language.Haskell.LSP.Types.CodeAction where

import           Control.Applicative
import           Data.Aeson.TH
import           Data.Aeson.Types
import           Data.Text                      ( Text )
import           Language.Haskell.LSP.Types.Command
import           Language.Haskell.LSP.Types.Constants
import           Language.Haskell.LSP.Types.Diagnostic
import           Language.Haskell.LSP.Types.List
import           Language.Haskell.LSP.Types.Location
import           Language.Haskell.LSP.Types.Message
import           Language.Haskell.LSP.Types.Progress
import           Language.Haskell.LSP.Types.TextDocument
import           Language.Haskell.LSP.Types.WorkspaceEdit


{-
Code Action Request

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#code-action-request

The code action request is sent from the client to the server to compute commands
for a given text document and range. These commands are typically code fixes to
either fix problems or to beautify/refactor code. The result of a
textDocument/codeAction request is an array of Command literals which are
typically presented in the user interface. When the command is selected the
server should be contacted again (via the workspace/executeCommand) request to
execute the command.

Since version 3.8.0: support for CodeAction litarals to enable the following
scenarios:

the ability to directly return a workspace edit from e code action request. This
avoids having another server roundtrip to execute an actual code action. However
server providers should be aware that if the code action is expensive to compute
or the edits are huge it might still be beneficial if the result is imply a
command and the actual edit is only computed when needed. the ability to group
code actions using a kind. Clients are allowed to ignore that information.
However it allows them to better group code action for example into
corresponding menus (e.g. all refactor code actions into a refactor menu).
Clients need to announce there support code action literals and code action
kinds via the corresponding client capability
textDocument.codeAction.codeActionLiteralSupport.

Request

    method: 'textDocument/codeAction'
    params: CodeActionParams defined as follows:

/**
 * Params for the CodeActionRequest
 */
interface CodeActionParams {
	/**
	 * The document in which the command was invoked.
	 */
	textDocument: TextDocumentIdentifier;

	/**
	 * The range for which the command was invoked.
	 */
	range: Range;

	/**
	 * Context carrying additional information.
	 */
	context: CodeActionContext;
}

/**
 * The kind of a code action.
 *
 * Kinds are a hierarchical list of identifiers separated by `.`, e.g. `"refactor.extract.function"`.
 *
 * The set of kinds is open and client needs to announce the kinds it supports to the server during
 * initialization.
 */
export type CodeActionKind = string;

/**
 * A set of predefined code action kinds
 */
export namespace CodeActionKind {
	/**
	 * Base kind for quickfix actions: 'quickfix'
	 */
	export const QuickFix: CodeActionKind = 'quickfix';

	/**
	 * Base kind for refactoring actions: 'refactor'
	 */
	export const Refactor: CodeActionKind = 'refactor';

	/**
	 * Base kind for refactoring extraction actions: 'refactor.extract'
	 *
	 * Example extract actions:
	 *
	 * - Extract method
	 * - Extract function
	 * - Extract variable
	 * - Extract interface from class
	 * - ...
	 */
	export const RefactorExtract: CodeActionKind = 'refactor.extract';

	/**
	 * Base kind for refactoring inline actions: 'refactor.inline'
	 *
	 * Example inline actions:
	 *
	 * - Inline function
	 * - Inline variable
	 * - Inline constant
	 * - ...
	 */
	export const RefactorInline: CodeActionKind = 'refactor.inline';

	/**
	 * Base kind for refactoring rewrite actions: 'refactor.rewrite'
	 *
	 * Example rewrite actions:
	 *
	 * - Convert JavaScript function to class
	 * - Add or remove parameter
	 * - Encapsulate field
	 * - Make method static
	 * - Move method to base class
	 * - ...
	 */
	export const RefactorRewrite: CodeActionKind = 'refactor.rewrite';

	/**
	 * Base kind for source actions: `source`
	 *
	 * Source code actions apply to the entire file.
	 */
	export const Source: CodeActionKind = 'source';

	/**
	 * Base kind for an organize imports source action: `source.organizeImports`
	 */
	export const SourceOrganizeImports: CodeActionKind = 'source.organizeImports';
}

/**
 * Contains additional diagnostic information about the context in which
 * a code action is run.
 */
interface CodeActionContext {
	/**
	 * An array of diagnostics.
	 */
	diagnostics: Diagnostic[];

	/**
	 * Requested kind of actions to return.
	 *
	 * Actions not of this kind are filtered out by the client before being shown. So servers
	 * can omit computing them.
	 */
	only?: CodeActionKind[];
}

Response

    result: (Command | CodeAction)[] | null where CodeAction is defined as follows:
        /**
    * A code action represents a change that can be performed in code, e.g. to fix a problem or
    * to refactor code.
    *
    * A CodeAction must set either `edit` and/or a `command`. If both are supplied, the `edit` is applied first, then the `command` is executed.
    */
    export interface CodeAction {

        /**
        * A short, human-readable, title for this code action.
        */
        title: string;

        /**
        * The kind of the code action.
        *
        * Used to filter code actions.
        */
        kind?: CodeActionKind;

        /**
        * The diagnostics that this code action resolves.
        */
        diagnostics?: Diagnostic[];

        /**
        * The workspace edit this code action performs.
        */
        edit?: WorkspaceEdit;

        /**
        * A command this code action executes. If a code action
        * provides an edit and a command, first the edit is
        * executed and then the command.
        */
        command?: Command;
    }
    error: code and message set in case an exception happens during the code
           action request.

-}

data CodeActionKind = CodeActionQuickFix
                    | CodeActionRefactor
                    | CodeActionRefactorExtract
                    | CodeActionRefactorInline
                    | CodeActionRefactorRewrite
                    | CodeActionSource
                    | CodeActionSourceOrganizeImports
                    | CodeActionUnknown Text
  deriving (ReadPrec [CodeActionKind]
ReadPrec CodeActionKind
Int -> ReadS CodeActionKind
ReadS [CodeActionKind]
(Int -> ReadS CodeActionKind)
-> ReadS [CodeActionKind]
-> ReadPrec CodeActionKind
-> ReadPrec [CodeActionKind]
-> Read CodeActionKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CodeActionKind]
$creadListPrec :: ReadPrec [CodeActionKind]
readPrec :: ReadPrec CodeActionKind
$creadPrec :: ReadPrec CodeActionKind
readList :: ReadS [CodeActionKind]
$creadList :: ReadS [CodeActionKind]
readsPrec :: Int -> ReadS CodeActionKind
$creadsPrec :: Int -> ReadS CodeActionKind
Read,Int -> CodeActionKind -> ShowS
[CodeActionKind] -> ShowS
CodeActionKind -> String
(Int -> CodeActionKind -> ShowS)
-> (CodeActionKind -> String)
-> ([CodeActionKind] -> ShowS)
-> Show CodeActionKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeActionKind] -> ShowS
$cshowList :: [CodeActionKind] -> ShowS
show :: CodeActionKind -> String
$cshow :: CodeActionKind -> String
showsPrec :: Int -> CodeActionKind -> ShowS
$cshowsPrec :: Int -> CodeActionKind -> ShowS
Show,CodeActionKind -> CodeActionKind -> Bool
(CodeActionKind -> CodeActionKind -> Bool)
-> (CodeActionKind -> CodeActionKind -> Bool) -> Eq CodeActionKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeActionKind -> CodeActionKind -> Bool
$c/= :: CodeActionKind -> CodeActionKind -> Bool
== :: CodeActionKind -> CodeActionKind -> Bool
$c== :: CodeActionKind -> CodeActionKind -> Bool
Eq)

instance ToJSON CodeActionKind where
  toJSON :: CodeActionKind -> Value
toJSON CodeActionKind
CodeActionQuickFix                   = Text -> Value
String Text
"quickfix"
  toJSON CodeActionKind
CodeActionRefactor                   = Text -> Value
String Text
"refactor"
  toJSON CodeActionKind
CodeActionRefactorExtract            = Text -> Value
String Text
"refactor.extract"
  toJSON CodeActionKind
CodeActionRefactorInline             = Text -> Value
String Text
"refactor.inline"
  toJSON CodeActionKind
CodeActionRefactorRewrite            = Text -> Value
String Text
"refactor.rewrite"
  toJSON CodeActionKind
CodeActionSource                     = Text -> Value
String Text
"source"
  toJSON CodeActionKind
CodeActionSourceOrganizeImports      = Text -> Value
String Text
"source.organizeImports"
  toJSON (CodeActionUnknown Text
s)                = Text -> Value
String Text
s

instance FromJSON CodeActionKind where
  parseJSON :: Value -> Parser CodeActionKind
parseJSON (String Text
"quickfix")               = CodeActionKind -> Parser CodeActionKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CodeActionKind
CodeActionQuickFix
  parseJSON (String Text
"refactor")               = CodeActionKind -> Parser CodeActionKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CodeActionKind
CodeActionRefactor
  parseJSON (String Text
"refactor.extract")       = CodeActionKind -> Parser CodeActionKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CodeActionKind
CodeActionRefactorExtract
  parseJSON (String Text
"refactor.inline")        = CodeActionKind -> Parser CodeActionKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CodeActionKind
CodeActionRefactorInline
  parseJSON (String Text
"refactor.rewrite")       = CodeActionKind -> Parser CodeActionKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CodeActionKind
CodeActionRefactorRewrite
  parseJSON (String Text
"source")                 = CodeActionKind -> Parser CodeActionKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CodeActionKind
CodeActionSource
  parseJSON (String Text
"source.organizeImports") = CodeActionKind -> Parser CodeActionKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CodeActionKind
CodeActionSourceOrganizeImports
  parseJSON (String Text
s)                        = CodeActionKind -> Parser CodeActionKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> CodeActionKind
CodeActionUnknown Text
s)
  parseJSON Value
_                                 = Parser CodeActionKind
forall a. Monoid a => a
mempty

data CodeActionContext =
  CodeActionContext
    { CodeActionContext -> List Diagnostic
_diagnostics :: List Diagnostic
    , CodeActionContext -> Maybe (List CodeActionKind)
only         :: Maybe (List CodeActionKind)
    } deriving (ReadPrec [CodeActionContext]
ReadPrec CodeActionContext
Int -> ReadS CodeActionContext
ReadS [CodeActionContext]
(Int -> ReadS CodeActionContext)
-> ReadS [CodeActionContext]
-> ReadPrec CodeActionContext
-> ReadPrec [CodeActionContext]
-> Read CodeActionContext
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CodeActionContext]
$creadListPrec :: ReadPrec [CodeActionContext]
readPrec :: ReadPrec CodeActionContext
$creadPrec :: ReadPrec CodeActionContext
readList :: ReadS [CodeActionContext]
$creadList :: ReadS [CodeActionContext]
readsPrec :: Int -> ReadS CodeActionContext
$creadsPrec :: Int -> ReadS CodeActionContext
Read,Int -> CodeActionContext -> ShowS
[CodeActionContext] -> ShowS
CodeActionContext -> String
(Int -> CodeActionContext -> ShowS)
-> (CodeActionContext -> String)
-> ([CodeActionContext] -> ShowS)
-> Show CodeActionContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeActionContext] -> ShowS
$cshowList :: [CodeActionContext] -> ShowS
show :: CodeActionContext -> String
$cshow :: CodeActionContext -> String
showsPrec :: Int -> CodeActionContext -> ShowS
$cshowsPrec :: Int -> CodeActionContext -> ShowS
Show,CodeActionContext -> CodeActionContext -> Bool
(CodeActionContext -> CodeActionContext -> Bool)
-> (CodeActionContext -> CodeActionContext -> Bool)
-> Eq CodeActionContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeActionContext -> CodeActionContext -> Bool
$c/= :: CodeActionContext -> CodeActionContext -> Bool
== :: CodeActionContext -> CodeActionContext -> Bool
$c== :: CodeActionContext -> CodeActionContext -> Bool
Eq)

deriveJSON lspOptions ''CodeActionContext


data CodeActionParams =
  CodeActionParams
    { CodeActionParams -> TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
    , CodeActionParams -> Range
_range        :: Range
    , CodeActionParams -> CodeActionContext
_context      :: CodeActionContext
    , CodeActionParams -> Maybe ProgressToken
_workDoneToken :: Maybe ProgressToken -- ^ An optional token that a server can use to report work done progress.
    } deriving (ReadPrec [CodeActionParams]
ReadPrec CodeActionParams
Int -> ReadS CodeActionParams
ReadS [CodeActionParams]
(Int -> ReadS CodeActionParams)
-> ReadS [CodeActionParams]
-> ReadPrec CodeActionParams
-> ReadPrec [CodeActionParams]
-> Read CodeActionParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CodeActionParams]
$creadListPrec :: ReadPrec [CodeActionParams]
readPrec :: ReadPrec CodeActionParams
$creadPrec :: ReadPrec CodeActionParams
readList :: ReadS [CodeActionParams]
$creadList :: ReadS [CodeActionParams]
readsPrec :: Int -> ReadS CodeActionParams
$creadsPrec :: Int -> ReadS CodeActionParams
Read,Int -> CodeActionParams -> ShowS
[CodeActionParams] -> ShowS
CodeActionParams -> String
(Int -> CodeActionParams -> ShowS)
-> (CodeActionParams -> String)
-> ([CodeActionParams] -> ShowS)
-> Show CodeActionParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeActionParams] -> ShowS
$cshowList :: [CodeActionParams] -> ShowS
show :: CodeActionParams -> String
$cshow :: CodeActionParams -> String
showsPrec :: Int -> CodeActionParams -> ShowS
$cshowsPrec :: Int -> CodeActionParams -> ShowS
Show,CodeActionParams -> CodeActionParams -> Bool
(CodeActionParams -> CodeActionParams -> Bool)
-> (CodeActionParams -> CodeActionParams -> Bool)
-> Eq CodeActionParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeActionParams -> CodeActionParams -> Bool
$c/= :: CodeActionParams -> CodeActionParams -> Bool
== :: CodeActionParams -> CodeActionParams -> Bool
$c== :: CodeActionParams -> CodeActionParams -> Bool
Eq)

deriveJSON lspOptions ''CodeActionParams

newtype Reason = Reason {Reason -> Text
_reason :: Text}
  deriving (ReadPrec [Reason]
ReadPrec Reason
Int -> ReadS Reason
ReadS [Reason]
(Int -> ReadS Reason)
-> ReadS [Reason]
-> ReadPrec Reason
-> ReadPrec [Reason]
-> Read Reason
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Reason]
$creadListPrec :: ReadPrec [Reason]
readPrec :: ReadPrec Reason
$creadPrec :: ReadPrec Reason
readList :: ReadS [Reason]
$creadList :: ReadS [Reason]
readsPrec :: Int -> ReadS Reason
$creadsPrec :: Int -> ReadS Reason
Read, Int -> Reason -> ShowS
[Reason] -> ShowS
Reason -> String
(Int -> Reason -> ShowS)
-> (Reason -> String) -> ([Reason] -> ShowS) -> Show Reason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reason] -> ShowS
$cshowList :: [Reason] -> ShowS
show :: Reason -> String
$cshow :: Reason -> String
showsPrec :: Int -> Reason -> ShowS
$cshowsPrec :: Int -> Reason -> ShowS
Show, Reason -> Reason -> Bool
(Reason -> Reason -> Bool)
-> (Reason -> Reason -> Bool) -> Eq Reason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reason -> Reason -> Bool
$c/= :: Reason -> Reason -> Bool
== :: Reason -> Reason -> Bool
$c== :: Reason -> Reason -> Bool
Eq)

deriveJSON lspOptions ''Reason
data CodeAction =
  -- | A code action represents a change that can be performed in code, e.g. to fix a problem or
  -- to refactor code.
  --
  -- A CodeAction must set either '_edit' and/or a '_command'. If both are supplied,
  -- the '_edit' is applied first, then the '_command' is executed.
  CodeAction
    { CodeAction -> Text
_title       :: Text -- ^ A short, human-readable, title for this code action.
    , CodeAction -> Maybe CodeActionKind
_kind        :: Maybe CodeActionKind -- ^ The kind of the code action. Used to filter code actions.
    , CodeAction -> Maybe (List Diagnostic)
_diagnostics :: Maybe (List Diagnostic) -- ^ The diagnostics that this code action resolves.
    , CodeAction -> Maybe WorkspaceEdit
_edit        :: Maybe WorkspaceEdit -- ^ The workspace edit this code action performs.
    , CodeAction -> Maybe Command
_command     :: Maybe Command -- ^ A command this code action executes. If a code action
                                    -- provides an edit and a command, first the edit is
                                    -- executed and then the command.
    , CodeAction -> Maybe Bool
_isPreferred :: Maybe Bool -- ^ Marks this as a preferred action.
                              -- Preferred actions are used by the `auto fix` command and can be targeted by keybindings.
                              -- A quick fix should be marked preferred if it properly addresses the underlying error.
                              -- A refactoring should be marked preferred if it is the most reasonable choice of actions to take.
    , CodeAction -> Maybe Reason
_disabled    :: Maybe Reason -- ^ Marks that the code action cannot currently be applied.
    } deriving (ReadPrec [CodeAction]
ReadPrec CodeAction
Int -> ReadS CodeAction
ReadS [CodeAction]
(Int -> ReadS CodeAction)
-> ReadS [CodeAction]
-> ReadPrec CodeAction
-> ReadPrec [CodeAction]
-> Read CodeAction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CodeAction]
$creadListPrec :: ReadPrec [CodeAction]
readPrec :: ReadPrec CodeAction
$creadPrec :: ReadPrec CodeAction
readList :: ReadS [CodeAction]
$creadList :: ReadS [CodeAction]
readsPrec :: Int -> ReadS CodeAction
$creadsPrec :: Int -> ReadS CodeAction
Read,Int -> CodeAction -> ShowS
[CodeAction] -> ShowS
CodeAction -> String
(Int -> CodeAction -> ShowS)
-> (CodeAction -> String)
-> ([CodeAction] -> ShowS)
-> Show CodeAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeAction] -> ShowS
$cshowList :: [CodeAction] -> ShowS
show :: CodeAction -> String
$cshow :: CodeAction -> String
showsPrec :: Int -> CodeAction -> ShowS
$cshowsPrec :: Int -> CodeAction -> ShowS
Show,CodeAction -> CodeAction -> Bool
(CodeAction -> CodeAction -> Bool)
-> (CodeAction -> CodeAction -> Bool) -> Eq CodeAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeAction -> CodeAction -> Bool
$c/= :: CodeAction -> CodeAction -> Bool
== :: CodeAction -> CodeAction -> Bool
$c== :: CodeAction -> CodeAction -> Bool
Eq)

deriveJSON lspOptions ''CodeAction

data CAResult = CACommand Command
              | CACodeAction CodeAction
  deriving (ReadPrec [CAResult]
ReadPrec CAResult
Int -> ReadS CAResult
ReadS [CAResult]
(Int -> ReadS CAResult)
-> ReadS [CAResult]
-> ReadPrec CAResult
-> ReadPrec [CAResult]
-> Read CAResult
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CAResult]
$creadListPrec :: ReadPrec [CAResult]
readPrec :: ReadPrec CAResult
$creadPrec :: ReadPrec CAResult
readList :: ReadS [CAResult]
$creadList :: ReadS [CAResult]
readsPrec :: Int -> ReadS CAResult
$creadsPrec :: Int -> ReadS CAResult
Read,Int -> CAResult -> ShowS
[CAResult] -> ShowS
CAResult -> String
(Int -> CAResult -> ShowS)
-> (CAResult -> String) -> ([CAResult] -> ShowS) -> Show CAResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CAResult] -> ShowS
$cshowList :: [CAResult] -> ShowS
show :: CAResult -> String
$cshow :: CAResult -> String
showsPrec :: Int -> CAResult -> ShowS
$cshowsPrec :: Int -> CAResult -> ShowS
Show,CAResult -> CAResult -> Bool
(CAResult -> CAResult -> Bool)
-> (CAResult -> CAResult -> Bool) -> Eq CAResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CAResult -> CAResult -> Bool
$c/= :: CAResult -> CAResult -> Bool
== :: CAResult -> CAResult -> Bool
$c== :: CAResult -> CAResult -> Bool
Eq)

instance FromJSON CAResult where
  parseJSON :: Value -> Parser CAResult
parseJSON Value
x = Command -> CAResult
CACommand (Command -> CAResult) -> Parser Command -> Parser CAResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Command
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x Parser CAResult -> Parser CAResult -> Parser CAResult
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CodeAction -> CAResult
CACodeAction (CodeAction -> CAResult) -> Parser CodeAction -> Parser CAResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CodeAction
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x

instance ToJSON CAResult where
  toJSON :: CAResult -> Value
toJSON (CACommand Command
x) = Command -> Value
forall a. ToJSON a => a -> Value
toJSON Command
x
  toJSON (CACodeAction CodeAction
x) = CodeAction -> Value
forall a. ToJSON a => a -> Value
toJSON CodeAction
x

type CodeActionRequest  = RequestMessage ClientMethod CodeActionParams (List CAResult)
type CodeActionResponse = ResponseMessage (List CAResult)