{- 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.SemanticTokensClientCapabilities 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 as Row
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.TokenFormat
import qualified Language.LSP.Protocol.Types.Common

{-|
@since 3.16.0
-}
data SemanticTokensClientCapabilities = SemanticTokensClientCapabilities 
  { {-|
  Whether implementation supports dynamic registration. If this is set to `true`
  the client supports the new `(TextDocumentRegistrationOptions & StaticRegistrationOptions)`
  return value for the corresponding server capability as well.
  -}
  SemanticTokensClientCapabilities -> Maybe Bool
_dynamicRegistration :: (Maybe Bool)
  , {-|
  Which requests the client supports and might send to the server
  depending on the server's capability. Please note that clients might not
  show semantic tokens or degrade some of the user experience if a range
  or full request is advertised by the client but not provided by the
  server. If for example the client capability `requests.full` and
  `request.range` are both set to true but the server only provides a
  range provider the client might not render a minimap correctly or might
  even decide to not show any semantic tokens at all.
  -}
  SemanticTokensClientCapabilities
-> Rec
     (("range" .== Maybe (Bool |? Rec Empty))
      .+ (("full"
           .== Maybe (Bool |? Rec (("delta" .== Maybe Bool) .+ Empty)))
          .+ Empty))
_requests :: (Row.Rec ("range" Row..== (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Row.Rec Row.Empty))) Row..+ ("full" Row..== (Maybe (Bool Language.LSP.Protocol.Types.Common.|? (Row.Rec ("delta" Row..== (Maybe Bool) Row..+ Row.Empty)))) Row..+ Row.Empty)))
  , {-|
  The token types that the client supports.
  -}
  SemanticTokensClientCapabilities -> [Text]
_tokenTypes :: [Data.Text.Text]
  , {-|
  The token modifiers that the client supports.
  -}
  SemanticTokensClientCapabilities -> [Text]
_tokenModifiers :: [Data.Text.Text]
  , {-|
  The token formats the clients supports.
  -}
  SemanticTokensClientCapabilities -> [TokenFormat]
_formats :: [Language.LSP.Protocol.Internal.Types.TokenFormat.TokenFormat]
  , {-|
  Whether the client supports tokens that can overlap each other.
  -}
  SemanticTokensClientCapabilities -> Maybe Bool
_overlappingTokenSupport :: (Maybe Bool)
  , {-|
  Whether the client supports tokens that can span multiple lines.
  -}
  SemanticTokensClientCapabilities -> Maybe Bool
_multilineTokenSupport :: (Maybe Bool)
  , {-|
  Whether the client allows the server to actively cancel a
  semantic token request, e.g. supports returning
  LSPErrorCodes.ServerCancelled. If a server does the client
  needs to retrigger the request.

  @since 3.17.0
  -}
  SemanticTokensClientCapabilities -> Maybe Bool
_serverCancelSupport :: (Maybe Bool)
  , {-|
  Whether the client uses semantic tokens to augment existing
  syntax tokens. If set to `true` client side created syntax
  tokens and semantic tokens are both used for colorization. If
  set to `false` the client only uses the returned semantic tokens
  for colorization.

  If the value is `undefined` then the client behavior is not
  specified.

  @since 3.17.0
  -}
  SemanticTokensClientCapabilities -> Maybe Bool
_augmentsSyntaxTokens :: (Maybe Bool)
  }
  deriving stock (Int -> SemanticTokensClientCapabilities -> ShowS
[SemanticTokensClientCapabilities] -> ShowS
SemanticTokensClientCapabilities -> String
(Int -> SemanticTokensClientCapabilities -> ShowS)
-> (SemanticTokensClientCapabilities -> String)
-> ([SemanticTokensClientCapabilities] -> ShowS)
-> Show SemanticTokensClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SemanticTokensClientCapabilities -> ShowS
showsPrec :: Int -> SemanticTokensClientCapabilities -> ShowS
$cshow :: SemanticTokensClientCapabilities -> String
show :: SemanticTokensClientCapabilities -> String
$cshowList :: [SemanticTokensClientCapabilities] -> ShowS
showList :: [SemanticTokensClientCapabilities] -> ShowS
Show, SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
(SemanticTokensClientCapabilities
 -> SemanticTokensClientCapabilities -> Bool)
-> (SemanticTokensClientCapabilities
    -> SemanticTokensClientCapabilities -> Bool)
-> Eq SemanticTokensClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
== :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
$c/= :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
/= :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
Eq, Eq SemanticTokensClientCapabilities
Eq SemanticTokensClientCapabilities =>
(SemanticTokensClientCapabilities
 -> SemanticTokensClientCapabilities -> Ordering)
-> (SemanticTokensClientCapabilities
    -> SemanticTokensClientCapabilities -> Bool)
-> (SemanticTokensClientCapabilities
    -> SemanticTokensClientCapabilities -> Bool)
-> (SemanticTokensClientCapabilities
    -> SemanticTokensClientCapabilities -> Bool)
-> (SemanticTokensClientCapabilities
    -> SemanticTokensClientCapabilities -> Bool)
-> (SemanticTokensClientCapabilities
    -> SemanticTokensClientCapabilities
    -> SemanticTokensClientCapabilities)
-> (SemanticTokensClientCapabilities
    -> SemanticTokensClientCapabilities
    -> SemanticTokensClientCapabilities)
-> Ord SemanticTokensClientCapabilities
SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Ordering
SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
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 :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Ordering
compare :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Ordering
$c< :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
< :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
$c<= :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
<= :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
$c> :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
> :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
$c>= :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
>= :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
$cmax :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
max :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
$cmin :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
min :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
Ord, (forall x.
 SemanticTokensClientCapabilities
 -> Rep SemanticTokensClientCapabilities x)
-> (forall x.
    Rep SemanticTokensClientCapabilities x
    -> SemanticTokensClientCapabilities)
-> Generic SemanticTokensClientCapabilities
forall x.
Rep SemanticTokensClientCapabilities x
-> SemanticTokensClientCapabilities
forall x.
SemanticTokensClientCapabilities
-> Rep SemanticTokensClientCapabilities x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SemanticTokensClientCapabilities
-> Rep SemanticTokensClientCapabilities x
from :: forall x.
SemanticTokensClientCapabilities
-> Rep SemanticTokensClientCapabilities x
$cto :: forall x.
Rep SemanticTokensClientCapabilities x
-> SemanticTokensClientCapabilities
to :: forall x.
Rep SemanticTokensClientCapabilities x
-> SemanticTokensClientCapabilities
Generic)
  deriving anyclass (SemanticTokensClientCapabilities -> ()
(SemanticTokensClientCapabilities -> ())
-> NFData SemanticTokensClientCapabilities
forall a. (a -> ()) -> NFData a
$crnf :: SemanticTokensClientCapabilities -> ()
rnf :: SemanticTokensClientCapabilities -> ()
NFData, Eq SemanticTokensClientCapabilities
Eq SemanticTokensClientCapabilities =>
(Int -> SemanticTokensClientCapabilities -> Int)
-> (SemanticTokensClientCapabilities -> Int)
-> Hashable SemanticTokensClientCapabilities
Int -> SemanticTokensClientCapabilities -> Int
SemanticTokensClientCapabilities -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SemanticTokensClientCapabilities -> Int
hashWithSalt :: Int -> SemanticTokensClientCapabilities -> Int
$chash :: SemanticTokensClientCapabilities -> Int
hash :: SemanticTokensClientCapabilities -> Int
Hashable)
  deriving (forall ann. SemanticTokensClientCapabilities -> Doc ann)
-> (forall ann. [SemanticTokensClientCapabilities] -> Doc ann)
-> Pretty SemanticTokensClientCapabilities
forall ann. [SemanticTokensClientCapabilities] -> Doc ann
forall ann. SemanticTokensClientCapabilities -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. SemanticTokensClientCapabilities -> Doc ann
pretty :: forall ann. SemanticTokensClientCapabilities -> Doc ann
$cprettyList :: forall ann. [SemanticTokensClientCapabilities] -> Doc ann
prettyList :: forall ann. [SemanticTokensClientCapabilities] -> Doc ann
Pretty via (ViaJSON SemanticTokensClientCapabilities)

instance Aeson.ToJSON SemanticTokensClientCapabilities where
  toJSON :: SemanticTokensClientCapabilities -> Value
toJSON (SemanticTokensClientCapabilities Maybe Bool
arg0 Rec
  (("range" .== Maybe (Bool |? Rec Empty))
   .+ (("full"
        .== Maybe (Bool |? Rec (("delta" .== Maybe Bool) .+ Empty)))
       .+ Empty))
arg1 [Text]
arg2 [Text]
arg3 [TokenFormat]
arg4 Maybe Bool
arg5 Maybe Bool
arg6 Maybe Bool
arg7 Maybe Bool
arg8) = [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
"dynamicRegistration" String -> Maybe Bool -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Bool
arg0
    ,[Key
"requests" Key
-> Rec
     ('R
        '["full" ':-> Maybe (Bool |? Rec ('R '["delta" ':-> Maybe Bool])),
          "range" ':-> Maybe (Bool |? Rec Empty)])
-> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Rec
  (("range" .== Maybe (Bool |? Rec Empty))
   .+ (("full"
        .== Maybe (Bool |? Rec (("delta" .== Maybe Bool) .+ Empty)))
       .+ Empty))
Rec
  ('R
     '["full" ':-> Maybe (Bool |? Rec ('R '["delta" ':-> Maybe Bool])),
       "range" ':-> Maybe (Bool |? Rec Empty)])
arg1]
    ,[Key
"tokenTypes" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= [Text]
arg2]
    ,[Key
"tokenModifiers" 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]
    ,[Key
"formats" Key -> [TokenFormat] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= [TokenFormat]
arg4]
    ,String
"overlappingTokenSupport" String -> Maybe Bool -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Bool
arg5
    ,String
"multilineTokenSupport" String -> Maybe Bool -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Bool
arg6
    ,String
"serverCancelSupport" String -> Maybe Bool -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Bool
arg7
    ,String
"augmentsSyntaxTokens" String -> Maybe Bool -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Bool
arg8]

instance Aeson.FromJSON SemanticTokensClientCapabilities where
  parseJSON :: Value -> Parser SemanticTokensClientCapabilities
parseJSON = String
-> (Object -> Parser SemanticTokensClientCapabilities)
-> Value
-> Parser SemanticTokensClientCapabilities
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"SemanticTokensClientCapabilities" ((Object -> Parser SemanticTokensClientCapabilities)
 -> Value -> Parser SemanticTokensClientCapabilities)
-> (Object -> Parser SemanticTokensClientCapabilities)
-> Value
-> Parser SemanticTokensClientCapabilities
forall a b. (a -> b) -> a -> b
$ \Object
arg -> Maybe Bool
-> Rec
     (("range" .== Maybe (Bool |? Rec Empty))
      .+ (("full"
           .== Maybe (Bool |? Rec (("delta" .== Maybe Bool) .+ Empty)))
          .+ Empty))
-> [Text]
-> [Text]
-> [TokenFormat]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> SemanticTokensClientCapabilities
Maybe Bool
-> Rec
     ('R
        '["full" ':-> Maybe (Bool |? Rec ('R '["delta" ':-> Maybe Bool])),
          "range" ':-> Maybe (Bool |? Rec Empty)])
-> [Text]
-> [Text]
-> [TokenFormat]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> SemanticTokensClientCapabilities
SemanticTokensClientCapabilities (Maybe Bool
 -> Rec
      ('R
         '["full" ':-> Maybe (Bool |? Rec ('R '["delta" ':-> Maybe Bool])),
           "range" ':-> Maybe (Bool |? Rec Empty)])
 -> [Text]
 -> [Text]
 -> [TokenFormat]
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> SemanticTokensClientCapabilities)
-> Parser (Maybe Bool)
-> Parser
     (Rec
        ('R
           '["full" ':-> Maybe (Bool |? Rec ('R '["delta" ':-> Maybe Bool])),
             "range" ':-> Maybe (Bool |? Rec Empty)])
      -> [Text]
      -> [Text]
      -> [TokenFormat]
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> SemanticTokensClientCapabilities)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg Object -> Key -> Parser (Maybe Bool)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"dynamicRegistration" Parser
  (Rec
     ('R
        '["full" ':-> Maybe (Bool |? Rec ('R '["delta" ':-> Maybe Bool])),
          "range" ':-> Maybe (Bool |? Rec Empty)])
   -> [Text]
   -> [Text]
   -> [TokenFormat]
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> SemanticTokensClientCapabilities)
-> Parser
     (Rec
        ('R
           '["full" ':-> Maybe (Bool |? Rec ('R '["delta" ':-> Maybe Bool])),
             "range" ':-> Maybe (Bool |? Rec Empty)]))
-> Parser
     ([Text]
      -> [Text]
      -> [TokenFormat]
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> SemanticTokensClientCapabilities)
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
     (Rec
        ('R
           '["full" ':-> Maybe (Bool |? Rec ('R '["delta" ':-> Maybe Bool])),
             "range" ':-> Maybe (Bool |? Rec Empty)]))
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"requests" Parser
  ([Text]
   -> [Text]
   -> [TokenFormat]
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> SemanticTokensClientCapabilities)
-> Parser [Text]
-> Parser
     ([Text]
      -> [TokenFormat]
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> SemanticTokensClientCapabilities)
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
"tokenTypes" Parser
  ([Text]
   -> [TokenFormat]
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> SemanticTokensClientCapabilities)
-> Parser [Text]
-> Parser
     ([TokenFormat]
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> SemanticTokensClientCapabilities)
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
"tokenModifiers" Parser
  ([TokenFormat]
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> SemanticTokensClientCapabilities)
-> Parser [TokenFormat]
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> SemanticTokensClientCapabilities)
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 [TokenFormat]
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"formats" Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> SemanticTokensClientCapabilities)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool -> Maybe Bool -> SemanticTokensClientCapabilities)
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 Bool)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"overlappingTokenSupport" Parser
  (Maybe Bool
   -> Maybe Bool -> Maybe Bool -> SemanticTokensClientCapabilities)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool -> Maybe Bool -> SemanticTokensClientCapabilities)
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 Bool)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"multilineTokenSupport" Parser
  (Maybe Bool -> Maybe Bool -> SemanticTokensClientCapabilities)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> SemanticTokensClientCapabilities)
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 Bool)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"serverCancelSupport" Parser (Maybe Bool -> SemanticTokensClientCapabilities)
-> Parser (Maybe Bool) -> Parser SemanticTokensClientCapabilities
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 Bool)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"augmentsSyntaxTokens"