{- ORMOLU_DISABLE -}
{- HLINT ignore -}
-- THIS IS A GENERATED FILE, DO NOT EDIT

{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
module Language.LSP.Protocol.Internal.Types.ExecuteCommandParams where

import Control.DeepSeq
import Data.Hashable
import GHC.Generics
import Language.LSP.Protocol.Utils.Misc
import Prettyprinter
import qualified Data.Aeson
import qualified Data.Aeson as Aeson
import qualified Data.Row.Aeson as Aeson
import qualified Data.Row.Hashable as Hashable
import qualified Data.Text
import qualified Language.LSP.Protocol.Internal.Types.ProgressToken
import qualified Language.LSP.Protocol.Types.Common

{-|
The parameters of a `ExecuteCommandRequest`.
-}
data ExecuteCommandParams = ExecuteCommandParams 
  { {-|
  An optional token that a server can use to report work done progress.
  -}
  ExecuteCommandParams -> Maybe ProgressToken
_workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken)
  , {-|
  The identifier of the actual command handler.
  -}
  ExecuteCommandParams -> Text
_command :: Data.Text.Text
  , {-|
  Arguments that the command should be invoked with.
  -}
  ExecuteCommandParams -> Maybe [Value]
_arguments :: (Maybe [Data.Aeson.Value])
  }
  deriving stock (Int -> ExecuteCommandParams -> ShowS
[ExecuteCommandParams] -> ShowS
ExecuteCommandParams -> String
(Int -> ExecuteCommandParams -> ShowS)
-> (ExecuteCommandParams -> String)
-> ([ExecuteCommandParams] -> ShowS)
-> Show ExecuteCommandParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecuteCommandParams -> ShowS
showsPrec :: Int -> ExecuteCommandParams -> ShowS
$cshow :: ExecuteCommandParams -> String
show :: ExecuteCommandParams -> String
$cshowList :: [ExecuteCommandParams] -> ShowS
showList :: [ExecuteCommandParams] -> ShowS
Show, ExecuteCommandParams -> ExecuteCommandParams -> Bool
(ExecuteCommandParams -> ExecuteCommandParams -> Bool)
-> (ExecuteCommandParams -> ExecuteCommandParams -> Bool)
-> Eq ExecuteCommandParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
== :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
$c/= :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
/= :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
Eq, Eq ExecuteCommandParams
Eq ExecuteCommandParams =>
(ExecuteCommandParams -> ExecuteCommandParams -> Ordering)
-> (ExecuteCommandParams -> ExecuteCommandParams -> Bool)
-> (ExecuteCommandParams -> ExecuteCommandParams -> Bool)
-> (ExecuteCommandParams -> ExecuteCommandParams -> Bool)
-> (ExecuteCommandParams -> ExecuteCommandParams -> Bool)
-> (ExecuteCommandParams
    -> ExecuteCommandParams -> ExecuteCommandParams)
-> (ExecuteCommandParams
    -> ExecuteCommandParams -> ExecuteCommandParams)
-> Ord ExecuteCommandParams
ExecuteCommandParams -> ExecuteCommandParams -> Bool
ExecuteCommandParams -> ExecuteCommandParams -> Ordering
ExecuteCommandParams
-> ExecuteCommandParams -> ExecuteCommandParams
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ExecuteCommandParams -> ExecuteCommandParams -> Ordering
compare :: ExecuteCommandParams -> ExecuteCommandParams -> Ordering
$c< :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
< :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
$c<= :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
<= :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
$c> :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
> :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
$c>= :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
>= :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
$cmax :: ExecuteCommandParams
-> ExecuteCommandParams -> ExecuteCommandParams
max :: ExecuteCommandParams
-> ExecuteCommandParams -> ExecuteCommandParams
$cmin :: ExecuteCommandParams
-> ExecuteCommandParams -> ExecuteCommandParams
min :: ExecuteCommandParams
-> ExecuteCommandParams -> ExecuteCommandParams
Ord, (forall x. ExecuteCommandParams -> Rep ExecuteCommandParams x)
-> (forall x. Rep ExecuteCommandParams x -> ExecuteCommandParams)
-> Generic ExecuteCommandParams
forall x. Rep ExecuteCommandParams x -> ExecuteCommandParams
forall x. ExecuteCommandParams -> Rep ExecuteCommandParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExecuteCommandParams -> Rep ExecuteCommandParams x
from :: forall x. ExecuteCommandParams -> Rep ExecuteCommandParams x
$cto :: forall x. Rep ExecuteCommandParams x -> ExecuteCommandParams
to :: forall x. Rep ExecuteCommandParams x -> ExecuteCommandParams
Generic)
  deriving anyclass (ExecuteCommandParams -> ()
(ExecuteCommandParams -> ()) -> NFData ExecuteCommandParams
forall a. (a -> ()) -> NFData a
$crnf :: ExecuteCommandParams -> ()
rnf :: ExecuteCommandParams -> ()
NFData, Eq ExecuteCommandParams
Eq ExecuteCommandParams =>
(Int -> ExecuteCommandParams -> Int)
-> (ExecuteCommandParams -> Int) -> Hashable ExecuteCommandParams
Int -> ExecuteCommandParams -> Int
ExecuteCommandParams -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ExecuteCommandParams -> Int
hashWithSalt :: Int -> ExecuteCommandParams -> Int
$chash :: ExecuteCommandParams -> Int
hash :: ExecuteCommandParams -> Int
Hashable)
  deriving (forall ann. ExecuteCommandParams -> Doc ann)
-> (forall ann. [ExecuteCommandParams] -> Doc ann)
-> Pretty ExecuteCommandParams
forall ann. [ExecuteCommandParams] -> Doc ann
forall ann. ExecuteCommandParams -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. ExecuteCommandParams -> Doc ann
pretty :: forall ann. ExecuteCommandParams -> Doc ann
$cprettyList :: forall ann. [ExecuteCommandParams] -> Doc ann
prettyList :: forall ann. [ExecuteCommandParams] -> Doc ann
Pretty via (ViaJSON ExecuteCommandParams)

instance Aeson.ToJSON ExecuteCommandParams where
  toJSON :: ExecuteCommandParams -> Value
toJSON (ExecuteCommandParams Maybe ProgressToken
arg0 Text
arg1 Maybe [Value]
arg2) = [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [[Pair]] -> [Pair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Pair]] -> [Pair]) -> [[Pair]] -> [Pair]
forall a b. (a -> b) -> a -> b
$  [String
"workDoneToken" String -> Maybe ProgressToken -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe ProgressToken
arg0
    ,[Key
"command" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
arg1]
    ,String
"arguments" String -> Maybe [Value] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe [Value]
arg2]

instance Aeson.FromJSON ExecuteCommandParams where
  parseJSON :: Value -> Parser ExecuteCommandParams
parseJSON = String
-> (Object -> Parser ExecuteCommandParams)
-> Value
-> Parser ExecuteCommandParams
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ExecuteCommandParams" ((Object -> Parser ExecuteCommandParams)
 -> Value -> Parser ExecuteCommandParams)
-> (Object -> Parser ExecuteCommandParams)
-> Value
-> Parser ExecuteCommandParams
forall a b. (a -> b) -> a -> b
$ \Object
arg -> Maybe ProgressToken
-> Text -> Maybe [Value] -> ExecuteCommandParams
ExecuteCommandParams (Maybe ProgressToken
 -> Text -> Maybe [Value] -> ExecuteCommandParams)
-> Parser (Maybe ProgressToken)
-> Parser (Text -> Maybe [Value] -> ExecuteCommandParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg Object -> Key -> Parser (Maybe ProgressToken)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"workDoneToken" Parser (Text -> Maybe [Value] -> ExecuteCommandParams)
-> Parser Text -> Parser (Maybe [Value] -> ExecuteCommandParams)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"command" Parser (Maybe [Value] -> ExecuteCommandParams)
-> Parser (Maybe [Value]) -> Parser ExecuteCommandParams
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg Object -> Key -> Parser (Maybe [Value])
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"arguments"