{- 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
     (Extend "range" (Maybe (Bool |? Rec Empty)) Empty
      .+ (("full"
           .== Maybe
                 (Bool |? Rec (Extend "delta" (Maybe Bool) Empty .+ 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokensClientCapabilities] -> ShowS
$cshowList :: [SemanticTokensClientCapabilities] -> ShowS
show :: SemanticTokensClientCapabilities -> String
$cshow :: SemanticTokensClientCapabilities -> String
showsPrec :: Int -> SemanticTokensClientCapabilities -> ShowS
$cshowsPrec :: Int -> SemanticTokensClientCapabilities -> ShowS
Show, SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
$c/= :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
== :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
$c== :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
Eq, Eq 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
min :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
$cmin :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
max :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
$cmax :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities
>= :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
$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
compare :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Ordering
$ccompare :: SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Ordering
Ord, 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
$cto :: forall x.
Rep SemanticTokensClientCapabilities x
-> SemanticTokensClientCapabilities
$cfrom :: forall x.
SemanticTokensClientCapabilities
-> Rep SemanticTokensClientCapabilities x
Generic)
  deriving anyclass (SemanticTokensClientCapabilities -> ()
forall a. (a -> ()) -> NFData a
rnf :: SemanticTokensClientCapabilities -> ()
$crnf :: SemanticTokensClientCapabilities -> ()
NFData, Eq SemanticTokensClientCapabilities
Int -> SemanticTokensClientCapabilities -> Int
SemanticTokensClientCapabilities -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SemanticTokensClientCapabilities -> Int
$chash :: SemanticTokensClientCapabilities -> Int
hashWithSalt :: Int -> SemanticTokensClientCapabilities -> Int
$chashWithSalt :: Int -> SemanticTokensClientCapabilities -> Int
Hashable)
  deriving forall ann. [SemanticTokensClientCapabilities] -> Doc ann
forall ann. SemanticTokensClientCapabilities -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [SemanticTokensClientCapabilities] -> Doc ann
$cprettyList :: forall ann. [SemanticTokensClientCapabilities] -> Doc ann
pretty :: forall ann. SemanticTokensClientCapabilities -> Doc ann
$cpretty :: forall ann. SemanticTokensClientCapabilities -> Doc ann
Pretty via (ViaJSON SemanticTokensClientCapabilities)

instance Aeson.ToJSON SemanticTokensClientCapabilities where
  toJSON :: SemanticTokensClientCapabilities -> Value
toJSON (SemanticTokensClientCapabilities Maybe Bool
arg0 Rec
  (Extend "range" (Maybe (Bool |? Rec Empty)) Empty
   .+ (("full"
        .== Maybe
              (Bool |? Rec (Extend "delta" (Maybe Bool) Empty .+ 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$  [String
"dynamicRegistration" forall kv v. (KeyValue kv, ToJSON v) => String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Bool
arg0
    ,[Key
"requests" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= Rec
  (Extend "range" (Maybe (Bool |? Rec Empty)) Empty
   .+ (("full"
        .== Maybe
              (Bool |? Rec (Extend "delta" (Maybe Bool) Empty .+ Empty)))
       .+ Empty))
arg1]
    ,[Key
"tokenTypes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= [Text]
arg2]
    ,[Key
"tokenModifiers" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= [Text]
arg3]
    ,[Key
"formats" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= [TokenFormat]
arg4]
    ,String
"overlappingTokenSupport" forall kv v. (KeyValue kv, ToJSON v) => String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Bool
arg5
    ,String
"multilineTokenSupport" forall kv v. (KeyValue kv, ToJSON v) => String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Bool
arg6
    ,String
"serverCancelSupport" forall kv v. (KeyValue kv, ToJSON v) => String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Bool
arg7
    ,String
"augmentsSyntaxTokens" forall kv v. (KeyValue 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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"SemanticTokensClientCapabilities" forall a b. (a -> b) -> a -> b
$ \Object
arg -> Maybe Bool
-> Rec
     (Extend "range" (Maybe (Bool |? Rec Empty)) Empty
      .+ (("full"
           .== Maybe
                 (Bool |? Rec (Extend "delta" (Maybe Bool) Empty .+ Empty)))
          .+ Empty))
-> [Text]
-> [Text]
-> [TokenFormat]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> SemanticTokensClientCapabilities
SemanticTokensClientCapabilities forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:! Key
"dynamicRegistration" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"requests" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"tokenTypes" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"tokenModifiers" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"formats" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:! Key
"overlappingTokenSupport" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:! Key
"multilineTokenSupport" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:! Key
"serverCancelSupport" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:! Key
"augmentsSyntaxTokens"