{- 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.SemanticTokensDeltaParams where

import Control.DeepSeq
import Data.Hashable
import GHC.Generics
import Language.LSP.Protocol.Utils.Misc
import Prettyprinter
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.Internal.Types.TextDocumentIdentifier
import qualified Language.LSP.Protocol.Types.Common

{-|
@since 3.16.0
-}
data SemanticTokensDeltaParams = SemanticTokensDeltaParams 
  { {-|
  An optional token that a server can use to report work done progress.
  -}
  SemanticTokensDeltaParams -> Maybe ProgressToken
_workDoneToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken)
  , {-|
  An optional token that a server can use to report partial results (e.g. streaming) to
  the client.
  -}
  SemanticTokensDeltaParams -> Maybe ProgressToken
_partialResultToken :: (Maybe Language.LSP.Protocol.Internal.Types.ProgressToken.ProgressToken)
  , {-|
  The text document.
  -}
  SemanticTokensDeltaParams -> TextDocumentIdentifier
_textDocument :: Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier
  , {-|
  The result id of a previous response. The result Id can either point to a full response
  or a delta response depending on what was received last.
  -}
  SemanticTokensDeltaParams -> Text
_previousResultId :: Data.Text.Text
  }
  deriving stock (Int -> SemanticTokensDeltaParams -> ShowS
[SemanticTokensDeltaParams] -> ShowS
SemanticTokensDeltaParams -> String
(Int -> SemanticTokensDeltaParams -> ShowS)
-> (SemanticTokensDeltaParams -> String)
-> ([SemanticTokensDeltaParams] -> ShowS)
-> Show SemanticTokensDeltaParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SemanticTokensDeltaParams -> ShowS
showsPrec :: Int -> SemanticTokensDeltaParams -> ShowS
$cshow :: SemanticTokensDeltaParams -> String
show :: SemanticTokensDeltaParams -> String
$cshowList :: [SemanticTokensDeltaParams] -> ShowS
showList :: [SemanticTokensDeltaParams] -> ShowS
Show, SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
(SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool)
-> (SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool)
-> Eq SemanticTokensDeltaParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
== :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
$c/= :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
/= :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
Eq, Eq SemanticTokensDeltaParams
Eq SemanticTokensDeltaParams =>
(SemanticTokensDeltaParams
 -> SemanticTokensDeltaParams -> Ordering)
-> (SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool)
-> (SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool)
-> (SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool)
-> (SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool)
-> (SemanticTokensDeltaParams
    -> SemanticTokensDeltaParams -> SemanticTokensDeltaParams)
-> (SemanticTokensDeltaParams
    -> SemanticTokensDeltaParams -> SemanticTokensDeltaParams)
-> Ord SemanticTokensDeltaParams
SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Ordering
SemanticTokensDeltaParams
-> SemanticTokensDeltaParams -> SemanticTokensDeltaParams
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 :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Ordering
compare :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Ordering
$c< :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
< :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
$c<= :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
<= :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
$c> :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
> :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
$c>= :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
>= :: SemanticTokensDeltaParams -> SemanticTokensDeltaParams -> Bool
$cmax :: SemanticTokensDeltaParams
-> SemanticTokensDeltaParams -> SemanticTokensDeltaParams
max :: SemanticTokensDeltaParams
-> SemanticTokensDeltaParams -> SemanticTokensDeltaParams
$cmin :: SemanticTokensDeltaParams
-> SemanticTokensDeltaParams -> SemanticTokensDeltaParams
min :: SemanticTokensDeltaParams
-> SemanticTokensDeltaParams -> SemanticTokensDeltaParams
Ord, (forall x.
 SemanticTokensDeltaParams -> Rep SemanticTokensDeltaParams x)
-> (forall x.
    Rep SemanticTokensDeltaParams x -> SemanticTokensDeltaParams)
-> Generic SemanticTokensDeltaParams
forall x.
Rep SemanticTokensDeltaParams x -> SemanticTokensDeltaParams
forall x.
SemanticTokensDeltaParams -> Rep SemanticTokensDeltaParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SemanticTokensDeltaParams -> Rep SemanticTokensDeltaParams x
from :: forall x.
SemanticTokensDeltaParams -> Rep SemanticTokensDeltaParams x
$cto :: forall x.
Rep SemanticTokensDeltaParams x -> SemanticTokensDeltaParams
to :: forall x.
Rep SemanticTokensDeltaParams x -> SemanticTokensDeltaParams
Generic)
  deriving anyclass (SemanticTokensDeltaParams -> ()
(SemanticTokensDeltaParams -> ())
-> NFData SemanticTokensDeltaParams
forall a. (a -> ()) -> NFData a
$crnf :: SemanticTokensDeltaParams -> ()
rnf :: SemanticTokensDeltaParams -> ()
NFData, Eq SemanticTokensDeltaParams
Eq SemanticTokensDeltaParams =>
(Int -> SemanticTokensDeltaParams -> Int)
-> (SemanticTokensDeltaParams -> Int)
-> Hashable SemanticTokensDeltaParams
Int -> SemanticTokensDeltaParams -> Int
SemanticTokensDeltaParams -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SemanticTokensDeltaParams -> Int
hashWithSalt :: Int -> SemanticTokensDeltaParams -> Int
$chash :: SemanticTokensDeltaParams -> Int
hash :: SemanticTokensDeltaParams -> Int
Hashable)
  deriving (forall ann. SemanticTokensDeltaParams -> Doc ann)
-> (forall ann. [SemanticTokensDeltaParams] -> Doc ann)
-> Pretty SemanticTokensDeltaParams
forall ann. [SemanticTokensDeltaParams] -> Doc ann
forall ann. SemanticTokensDeltaParams -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. SemanticTokensDeltaParams -> Doc ann
pretty :: forall ann. SemanticTokensDeltaParams -> Doc ann
$cprettyList :: forall ann. [SemanticTokensDeltaParams] -> Doc ann
prettyList :: forall ann. [SemanticTokensDeltaParams] -> Doc ann
Pretty via (ViaJSON SemanticTokensDeltaParams)

instance Aeson.ToJSON SemanticTokensDeltaParams where
  toJSON :: SemanticTokensDeltaParams -> Value
toJSON (SemanticTokensDeltaParams Maybe ProgressToken
arg0 Maybe ProgressToken
arg1 TextDocumentIdentifier
arg2 Text
arg3) = [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
    ,String
"partialResultToken" String -> Maybe ProgressToken -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe ProgressToken
arg1
    ,[Key
"textDocument" Key -> TextDocumentIdentifier -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= TextDocumentIdentifier
arg2]
    ,[Key
"previousResultId" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
arg3]]

instance Aeson.FromJSON SemanticTokensDeltaParams where
  parseJSON :: Value -> Parser SemanticTokensDeltaParams
parseJSON = String
-> (Object -> Parser SemanticTokensDeltaParams)
-> Value
-> Parser SemanticTokensDeltaParams
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"SemanticTokensDeltaParams" ((Object -> Parser SemanticTokensDeltaParams)
 -> Value -> Parser SemanticTokensDeltaParams)
-> (Object -> Parser SemanticTokensDeltaParams)
-> Value
-> Parser SemanticTokensDeltaParams
forall a b. (a -> b) -> a -> b
$ \Object
arg -> Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> Text
-> SemanticTokensDeltaParams
SemanticTokensDeltaParams (Maybe ProgressToken
 -> Maybe ProgressToken
 -> TextDocumentIdentifier
 -> Text
 -> SemanticTokensDeltaParams)
-> Parser (Maybe ProgressToken)
-> Parser
     (Maybe ProgressToken
      -> TextDocumentIdentifier -> Text -> SemanticTokensDeltaParams)
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
  (Maybe ProgressToken
   -> TextDocumentIdentifier -> Text -> SemanticTokensDeltaParams)
-> Parser (Maybe ProgressToken)
-> Parser
     (TextDocumentIdentifier -> Text -> SemanticTokensDeltaParams)
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 ProgressToken)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"partialResultToken" Parser
  (TextDocumentIdentifier -> Text -> SemanticTokensDeltaParams)
-> Parser TextDocumentIdentifier
-> Parser (Text -> SemanticTokensDeltaParams)
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 TextDocumentIdentifier
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"textDocument" Parser (Text -> SemanticTokensDeltaParams)
-> Parser Text -> Parser SemanticTokensDeltaParams
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
"previousResultId"