{-# LANGUAGE TemplateHaskell            #-}

module Language.Haskell.LSP.Types.Command where

import           Data.Aeson
import           Data.Aeson.TH
import           Data.Text
import           Language.Haskell.LSP.Types.Constants
import           Language.Haskell.LSP.Types.List
-- ---------------------------------------------------------------------
{-
Command

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#command

Represents a reference to a command. Provides a title which will be used to
represent a command in the UI. Commands are identitifed using a string
identifier and the protocol currently doesn't specify a set of well known
commands. So executing a command requires some tool extension code.

interface Command {
    /**
     * Title of the command, like `save`.
     */
    title: string;
    /**
     * The identifier of the actual command handler.
     */
    command: string;
    /**
     * Arguments that the command handler should be
     * invoked with.
     */
    arguments?: any[];
}
-}

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

deriveJSON lspOptions ''Command