{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLists       #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskell       #-}
module Language.LSP.Types.SemanticTokens where

import qualified Data.Aeson                                   as A
import           Data.Aeson.TH
import           Data.Text                                    (Text)

import           Control.Monad.Except

import           Language.LSP.Types.Common
import           Language.LSP.Types.Location
import           Language.LSP.Types.Progress
import           Language.LSP.Types.StaticRegistrationOptions
import           Language.LSP.Types.TextDocument
import           Language.LSP.Types.Utils

import qualified Data.Algorithm.Diff                          as Diff
import qualified Data.Bits                                    as Bits
import qualified Data.DList                                   as DList
import           Data.Default
import           Data.Foldable                                hiding (length)
import qualified Data.Map                                     as Map
import           Data.Maybe                                   (fromMaybe,
                                                               maybeToList)
import           Data.String

data SemanticTokenTypes =
  SttType
  | SttClass
  | SttEnum
  | SttInterface
  | SttStruct
  | SttTypeParameter
  | SttParameter
  | SttVariable
  | SttProperty
  | SttEnumMember
  | SttEvent
  | SttFunction
  | SttMethod
  | SttMacro
  | SttKeyword
  | SttModifier
  | SttComment
  | SttString
  | SttNumber
  | SttRegexp
  | SttOperator
  | SttUnknown Text
  deriving (Int -> SemanticTokenTypes -> ShowS
[SemanticTokenTypes] -> ShowS
SemanticTokenTypes -> String
(Int -> SemanticTokenTypes -> ShowS)
-> (SemanticTokenTypes -> String)
-> ([SemanticTokenTypes] -> ShowS)
-> Show SemanticTokenTypes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokenTypes] -> ShowS
$cshowList :: [SemanticTokenTypes] -> ShowS
show :: SemanticTokenTypes -> String
$cshow :: SemanticTokenTypes -> String
showsPrec :: Int -> SemanticTokenTypes -> ShowS
$cshowsPrec :: Int -> SemanticTokenTypes -> ShowS
Show, ReadPrec [SemanticTokenTypes]
ReadPrec SemanticTokenTypes
Int -> ReadS SemanticTokenTypes
ReadS [SemanticTokenTypes]
(Int -> ReadS SemanticTokenTypes)
-> ReadS [SemanticTokenTypes]
-> ReadPrec SemanticTokenTypes
-> ReadPrec [SemanticTokenTypes]
-> Read SemanticTokenTypes
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokenTypes]
$creadListPrec :: ReadPrec [SemanticTokenTypes]
readPrec :: ReadPrec SemanticTokenTypes
$creadPrec :: ReadPrec SemanticTokenTypes
readList :: ReadS [SemanticTokenTypes]
$creadList :: ReadS [SemanticTokenTypes]
readsPrec :: Int -> ReadS SemanticTokenTypes
$creadsPrec :: Int -> ReadS SemanticTokenTypes
Read, SemanticTokenTypes -> SemanticTokenTypes -> Bool
(SemanticTokenTypes -> SemanticTokenTypes -> Bool)
-> (SemanticTokenTypes -> SemanticTokenTypes -> Bool)
-> Eq SemanticTokenTypes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokenTypes -> SemanticTokenTypes -> Bool
$c/= :: SemanticTokenTypes -> SemanticTokenTypes -> Bool
== :: SemanticTokenTypes -> SemanticTokenTypes -> Bool
$c== :: SemanticTokenTypes -> SemanticTokenTypes -> Bool
Eq, Eq SemanticTokenTypes
Eq SemanticTokenTypes
-> (SemanticTokenTypes -> SemanticTokenTypes -> Ordering)
-> (SemanticTokenTypes -> SemanticTokenTypes -> Bool)
-> (SemanticTokenTypes -> SemanticTokenTypes -> Bool)
-> (SemanticTokenTypes -> SemanticTokenTypes -> Bool)
-> (SemanticTokenTypes -> SemanticTokenTypes -> Bool)
-> (SemanticTokenTypes -> SemanticTokenTypes -> SemanticTokenTypes)
-> (SemanticTokenTypes -> SemanticTokenTypes -> SemanticTokenTypes)
-> Ord SemanticTokenTypes
SemanticTokenTypes -> SemanticTokenTypes -> Bool
SemanticTokenTypes -> SemanticTokenTypes -> Ordering
SemanticTokenTypes -> SemanticTokenTypes -> SemanticTokenTypes
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 :: SemanticTokenTypes -> SemanticTokenTypes -> SemanticTokenTypes
$cmin :: SemanticTokenTypes -> SemanticTokenTypes -> SemanticTokenTypes
max :: SemanticTokenTypes -> SemanticTokenTypes -> SemanticTokenTypes
$cmax :: SemanticTokenTypes -> SemanticTokenTypes -> SemanticTokenTypes
>= :: SemanticTokenTypes -> SemanticTokenTypes -> Bool
$c>= :: SemanticTokenTypes -> SemanticTokenTypes -> Bool
> :: SemanticTokenTypes -> SemanticTokenTypes -> Bool
$c> :: SemanticTokenTypes -> SemanticTokenTypes -> Bool
<= :: SemanticTokenTypes -> SemanticTokenTypes -> Bool
$c<= :: SemanticTokenTypes -> SemanticTokenTypes -> Bool
< :: SemanticTokenTypes -> SemanticTokenTypes -> Bool
$c< :: SemanticTokenTypes -> SemanticTokenTypes -> Bool
compare :: SemanticTokenTypes -> SemanticTokenTypes -> Ordering
$ccompare :: SemanticTokenTypes -> SemanticTokenTypes -> Ordering
$cp1Ord :: Eq SemanticTokenTypes
Ord)

instance A.ToJSON SemanticTokenTypes where
  toJSON :: SemanticTokenTypes -> Value
toJSON SemanticTokenTypes
SttType          = Text -> Value
A.String Text
"type"
  toJSON SemanticTokenTypes
SttClass         = Text -> Value
A.String Text
"class"
  toJSON SemanticTokenTypes
SttEnum          = Text -> Value
A.String Text
"enum"
  toJSON SemanticTokenTypes
SttInterface     = Text -> Value
A.String Text
"interface"
  toJSON SemanticTokenTypes
SttStruct        = Text -> Value
A.String Text
"struct"
  toJSON SemanticTokenTypes
SttTypeParameter = Text -> Value
A.String Text
"typeParameter"
  toJSON SemanticTokenTypes
SttParameter     = Text -> Value
A.String Text
"parameter"
  toJSON SemanticTokenTypes
SttVariable      = Text -> Value
A.String Text
"variable"
  toJSON SemanticTokenTypes
SttProperty      = Text -> Value
A.String Text
"property"
  toJSON SemanticTokenTypes
SttEnumMember    = Text -> Value
A.String Text
"enumMember"
  toJSON SemanticTokenTypes
SttEvent         = Text -> Value
A.String Text
"event"
  toJSON SemanticTokenTypes
SttFunction      = Text -> Value
A.String Text
"function"
  toJSON SemanticTokenTypes
SttMethod        = Text -> Value
A.String Text
"method"
  toJSON SemanticTokenTypes
SttMacro         = Text -> Value
A.String Text
"macro"
  toJSON SemanticTokenTypes
SttKeyword       = Text -> Value
A.String Text
"keyword"
  toJSON SemanticTokenTypes
SttModifier      = Text -> Value
A.String Text
"modifier"
  toJSON SemanticTokenTypes
SttComment       = Text -> Value
A.String Text
"comment"
  toJSON SemanticTokenTypes
SttString        = Text -> Value
A.String Text
"string"
  toJSON SemanticTokenTypes
SttNumber        = Text -> Value
A.String Text
"number"
  toJSON SemanticTokenTypes
SttRegexp        = Text -> Value
A.String Text
"regexp"
  toJSON SemanticTokenTypes
SttOperator      = Text -> Value
A.String Text
"operator"
  toJSON (SttUnknown Text
t)   = Text -> Value
A.String Text
t

instance A.FromJSON SemanticTokenTypes where
  parseJSON :: Value -> Parser SemanticTokenTypes
parseJSON (A.String Text
"type")          = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttType
  parseJSON (A.String Text
"class")         = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttClass
  parseJSON (A.String Text
"enum")          = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttEnum
  parseJSON (A.String Text
"interface")     = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttInterface
  parseJSON (A.String Text
"struct")        = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttStruct
  parseJSON (A.String Text
"typeParameter") = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttTypeParameter
  parseJSON (A.String Text
"parameter")     = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttParameter
  parseJSON (A.String Text
"variable")      = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttVariable
  parseJSON (A.String Text
"property")      = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttProperty
  parseJSON (A.String Text
"enumMember")    = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttEnumMember
  parseJSON (A.String Text
"event")         = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttEvent
  parseJSON (A.String Text
"function")      = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttFunction
  parseJSON (A.String Text
"method")        = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttMethod
  parseJSON (A.String Text
"macro")         = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttMacro
  parseJSON (A.String Text
"keyword")       = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttKeyword
  parseJSON (A.String Text
"modifier")      = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttModifier
  parseJSON (A.String Text
"comment")       = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttComment
  parseJSON (A.String Text
"string")        = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttString
  parseJSON (A.String Text
"number")        = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttNumber
  parseJSON (A.String Text
"regexp")        = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttRegexp
  parseJSON (A.String Text
"operator")      = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenTypes
SttOperator
  parseJSON (A.String Text
t)               = SemanticTokenTypes -> Parser SemanticTokenTypes
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SemanticTokenTypes -> Parser SemanticTokenTypes)
-> SemanticTokenTypes -> Parser SemanticTokenTypes
forall a b. (a -> b) -> a -> b
$ Text -> SemanticTokenTypes
SttUnknown Text
t
  parseJSON Value
_                          = Parser SemanticTokenTypes
forall a. Monoid a => a
mempty

-- | The set of semantic token types which are "known" (i.e. listed in the LSP spec).
knownSemanticTokenTypes :: [SemanticTokenTypes]
knownSemanticTokenTypes :: [SemanticTokenTypes]
knownSemanticTokenTypes = [
  Item [SemanticTokenTypes]
SemanticTokenTypes
SttType
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttClass
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttEnum
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttInterface
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttStruct
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttTypeParameter
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttParameter
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttVariable
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttProperty
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttEnumMember
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttEvent
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttFunction
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttMethod
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttMacro
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttKeyword
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttModifier
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttComment
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttString
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttNumber
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttRegexp
  , Item [SemanticTokenTypes]
SemanticTokenTypes
SttOperator
  ]

data SemanticTokenModifiers =
  StmDeclaration
  | StmDefinition
  | StmReadonly
  | StmStatic
  | StmDeprecated
  | StmAbstract
  | StmAsync
  | StmModification
  | StmDocumentation
  | StmDefaultLibrary
  | StmUnknown Text
  deriving (Int -> SemanticTokenModifiers -> ShowS
[SemanticTokenModifiers] -> ShowS
SemanticTokenModifiers -> String
(Int -> SemanticTokenModifiers -> ShowS)
-> (SemanticTokenModifiers -> String)
-> ([SemanticTokenModifiers] -> ShowS)
-> Show SemanticTokenModifiers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokenModifiers] -> ShowS
$cshowList :: [SemanticTokenModifiers] -> ShowS
show :: SemanticTokenModifiers -> String
$cshow :: SemanticTokenModifiers -> String
showsPrec :: Int -> SemanticTokenModifiers -> ShowS
$cshowsPrec :: Int -> SemanticTokenModifiers -> ShowS
Show, ReadPrec [SemanticTokenModifiers]
ReadPrec SemanticTokenModifiers
Int -> ReadS SemanticTokenModifiers
ReadS [SemanticTokenModifiers]
(Int -> ReadS SemanticTokenModifiers)
-> ReadS [SemanticTokenModifiers]
-> ReadPrec SemanticTokenModifiers
-> ReadPrec [SemanticTokenModifiers]
-> Read SemanticTokenModifiers
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokenModifiers]
$creadListPrec :: ReadPrec [SemanticTokenModifiers]
readPrec :: ReadPrec SemanticTokenModifiers
$creadPrec :: ReadPrec SemanticTokenModifiers
readList :: ReadS [SemanticTokenModifiers]
$creadList :: ReadS [SemanticTokenModifiers]
readsPrec :: Int -> ReadS SemanticTokenModifiers
$creadsPrec :: Int -> ReadS SemanticTokenModifiers
Read, SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
(SemanticTokenModifiers -> SemanticTokenModifiers -> Bool)
-> (SemanticTokenModifiers -> SemanticTokenModifiers -> Bool)
-> Eq SemanticTokenModifiers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
$c/= :: SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
== :: SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
$c== :: SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
Eq, Eq SemanticTokenModifiers
Eq SemanticTokenModifiers
-> (SemanticTokenModifiers -> SemanticTokenModifiers -> Ordering)
-> (SemanticTokenModifiers -> SemanticTokenModifiers -> Bool)
-> (SemanticTokenModifiers -> SemanticTokenModifiers -> Bool)
-> (SemanticTokenModifiers -> SemanticTokenModifiers -> Bool)
-> (SemanticTokenModifiers -> SemanticTokenModifiers -> Bool)
-> (SemanticTokenModifiers
    -> SemanticTokenModifiers -> SemanticTokenModifiers)
-> (SemanticTokenModifiers
    -> SemanticTokenModifiers -> SemanticTokenModifiers)
-> Ord SemanticTokenModifiers
SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
SemanticTokenModifiers -> SemanticTokenModifiers -> Ordering
SemanticTokenModifiers
-> SemanticTokenModifiers -> SemanticTokenModifiers
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 :: SemanticTokenModifiers
-> SemanticTokenModifiers -> SemanticTokenModifiers
$cmin :: SemanticTokenModifiers
-> SemanticTokenModifiers -> SemanticTokenModifiers
max :: SemanticTokenModifiers
-> SemanticTokenModifiers -> SemanticTokenModifiers
$cmax :: SemanticTokenModifiers
-> SemanticTokenModifiers -> SemanticTokenModifiers
>= :: SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
$c>= :: SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
> :: SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
$c> :: SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
<= :: SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
$c<= :: SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
< :: SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
$c< :: SemanticTokenModifiers -> SemanticTokenModifiers -> Bool
compare :: SemanticTokenModifiers -> SemanticTokenModifiers -> Ordering
$ccompare :: SemanticTokenModifiers -> SemanticTokenModifiers -> Ordering
$cp1Ord :: Eq SemanticTokenModifiers
Ord)

instance A.ToJSON SemanticTokenModifiers where
  toJSON :: SemanticTokenModifiers -> Value
toJSON SemanticTokenModifiers
StmDeclaration    = Text -> Value
A.String Text
"declaration"
  toJSON SemanticTokenModifiers
StmDefinition     = Text -> Value
A.String Text
"definition"
  toJSON SemanticTokenModifiers
StmReadonly       = Text -> Value
A.String Text
"readonly"
  toJSON SemanticTokenModifiers
StmStatic         = Text -> Value
A.String Text
"static"
  toJSON SemanticTokenModifiers
StmDeprecated     = Text -> Value
A.String Text
"deprecated"
  toJSON SemanticTokenModifiers
StmAbstract       = Text -> Value
A.String Text
"abstract"
  toJSON SemanticTokenModifiers
StmAsync          = Text -> Value
A.String Text
"async"
  toJSON SemanticTokenModifiers
StmModification   = Text -> Value
A.String Text
"modification"
  toJSON SemanticTokenModifiers
StmDocumentation  = Text -> Value
A.String Text
"documentation"
  toJSON SemanticTokenModifiers
StmDefaultLibrary = Text -> Value
A.String Text
"defaultLibrary"
  toJSON (StmUnknown Text
t)    = Text -> Value
A.String Text
t

instance A.FromJSON SemanticTokenModifiers where
  parseJSON :: Value -> Parser SemanticTokenModifiers
parseJSON (A.String Text
"declaration")    = SemanticTokenModifiers -> Parser SemanticTokenModifiers
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenModifiers
StmDeclaration
  parseJSON (A.String Text
"definition")     = SemanticTokenModifiers -> Parser SemanticTokenModifiers
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenModifiers
StmDefinition
  parseJSON (A.String Text
"readonly")       = SemanticTokenModifiers -> Parser SemanticTokenModifiers
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenModifiers
StmReadonly
  parseJSON (A.String Text
"static")         = SemanticTokenModifiers -> Parser SemanticTokenModifiers
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenModifiers
StmStatic
  parseJSON (A.String Text
"deprecated")     = SemanticTokenModifiers -> Parser SemanticTokenModifiers
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenModifiers
StmDeprecated
  parseJSON (A.String Text
"abstract")       = SemanticTokenModifiers -> Parser SemanticTokenModifiers
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenModifiers
StmAbstract
  parseJSON (A.String Text
"async")          = SemanticTokenModifiers -> Parser SemanticTokenModifiers
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenModifiers
StmAsync
  parseJSON (A.String Text
"modification")   = SemanticTokenModifiers -> Parser SemanticTokenModifiers
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenModifiers
StmModification
  parseJSON (A.String Text
"documentation")  = SemanticTokenModifiers -> Parser SemanticTokenModifiers
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenModifiers
StmDocumentation
  parseJSON (A.String Text
"defaultLibrary") = SemanticTokenModifiers -> Parser SemanticTokenModifiers
forall (f :: * -> *) a. Applicative f => a -> f a
pure SemanticTokenModifiers
StmDefaultLibrary
  parseJSON (A.String Text
t)                = SemanticTokenModifiers -> Parser SemanticTokenModifiers
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SemanticTokenModifiers -> Parser SemanticTokenModifiers)
-> SemanticTokenModifiers -> Parser SemanticTokenModifiers
forall a b. (a -> b) -> a -> b
$ Text -> SemanticTokenModifiers
StmUnknown Text
t
  parseJSON Value
_                           = Parser SemanticTokenModifiers
forall a. Monoid a => a
mempty

-- | The set of semantic token modifiers which are "known" (i.e. listed in the LSP spec).
knownSemanticTokenModifiers :: [SemanticTokenModifiers]
knownSemanticTokenModifiers :: [SemanticTokenModifiers]
knownSemanticTokenModifiers = [
  Item [SemanticTokenModifiers]
SemanticTokenModifiers
StmDeclaration
  , Item [SemanticTokenModifiers]
SemanticTokenModifiers
StmDefinition
  , Item [SemanticTokenModifiers]
SemanticTokenModifiers
StmReadonly
  , Item [SemanticTokenModifiers]
SemanticTokenModifiers
StmStatic
  , Item [SemanticTokenModifiers]
SemanticTokenModifiers
StmDeprecated
  , Item [SemanticTokenModifiers]
SemanticTokenModifiers
StmAbstract
  , Item [SemanticTokenModifiers]
SemanticTokenModifiers
StmAsync
  , Item [SemanticTokenModifiers]
SemanticTokenModifiers
StmModification
  , Item [SemanticTokenModifiers]
SemanticTokenModifiers
StmDocumentation
  , Item [SemanticTokenModifiers]
SemanticTokenModifiers
StmDefaultLibrary
  ]

data TokenFormat = TokenFormatRelative
  deriving (Int -> TokenFormat -> ShowS
[TokenFormat] -> ShowS
TokenFormat -> String
(Int -> TokenFormat -> ShowS)
-> (TokenFormat -> String)
-> ([TokenFormat] -> ShowS)
-> Show TokenFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenFormat] -> ShowS
$cshowList :: [TokenFormat] -> ShowS
show :: TokenFormat -> String
$cshow :: TokenFormat -> String
showsPrec :: Int -> TokenFormat -> ShowS
$cshowsPrec :: Int -> TokenFormat -> ShowS
Show, ReadPrec [TokenFormat]
ReadPrec TokenFormat
Int -> ReadS TokenFormat
ReadS [TokenFormat]
(Int -> ReadS TokenFormat)
-> ReadS [TokenFormat]
-> ReadPrec TokenFormat
-> ReadPrec [TokenFormat]
-> Read TokenFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TokenFormat]
$creadListPrec :: ReadPrec [TokenFormat]
readPrec :: ReadPrec TokenFormat
$creadPrec :: ReadPrec TokenFormat
readList :: ReadS [TokenFormat]
$creadList :: ReadS [TokenFormat]
readsPrec :: Int -> ReadS TokenFormat
$creadsPrec :: Int -> ReadS TokenFormat
Read, TokenFormat -> TokenFormat -> Bool
(TokenFormat -> TokenFormat -> Bool)
-> (TokenFormat -> TokenFormat -> Bool) -> Eq TokenFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenFormat -> TokenFormat -> Bool
$c/= :: TokenFormat -> TokenFormat -> Bool
== :: TokenFormat -> TokenFormat -> Bool
$c== :: TokenFormat -> TokenFormat -> Bool
Eq)

instance A.ToJSON TokenFormat where
  toJSON :: TokenFormat -> Value
toJSON TokenFormat
TokenFormatRelative = Text -> Value
A.String Text
"relative"

instance A.FromJSON TokenFormat where
  parseJSON :: Value -> Parser TokenFormat
parseJSON (A.String Text
"relative") = TokenFormat -> Parser TokenFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure TokenFormat
TokenFormatRelative
  parseJSON Value
_                     = Parser TokenFormat
forall a. Monoid a => a
mempty

data SemanticTokensLegend = SemanticTokensLegend {
  -- | The token types a server uses.
  SemanticTokensLegend -> List SemanticTokenTypes
_tokenTypes     :: List SemanticTokenTypes,
  -- | The token modifiers a server uses.
  SemanticTokensLegend -> List SemanticTokenModifiers
_tokenModifiers :: List SemanticTokenModifiers
} deriving (Int -> SemanticTokensLegend -> ShowS
[SemanticTokensLegend] -> ShowS
SemanticTokensLegend -> String
(Int -> SemanticTokensLegend -> ShowS)
-> (SemanticTokensLegend -> String)
-> ([SemanticTokensLegend] -> ShowS)
-> Show SemanticTokensLegend
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokensLegend] -> ShowS
$cshowList :: [SemanticTokensLegend] -> ShowS
show :: SemanticTokensLegend -> String
$cshow :: SemanticTokensLegend -> String
showsPrec :: Int -> SemanticTokensLegend -> ShowS
$cshowsPrec :: Int -> SemanticTokensLegend -> ShowS
Show, ReadPrec [SemanticTokensLegend]
ReadPrec SemanticTokensLegend
Int -> ReadS SemanticTokensLegend
ReadS [SemanticTokensLegend]
(Int -> ReadS SemanticTokensLegend)
-> ReadS [SemanticTokensLegend]
-> ReadPrec SemanticTokensLegend
-> ReadPrec [SemanticTokensLegend]
-> Read SemanticTokensLegend
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokensLegend]
$creadListPrec :: ReadPrec [SemanticTokensLegend]
readPrec :: ReadPrec SemanticTokensLegend
$creadPrec :: ReadPrec SemanticTokensLegend
readList :: ReadS [SemanticTokensLegend]
$creadList :: ReadS [SemanticTokensLegend]
readsPrec :: Int -> ReadS SemanticTokensLegend
$creadsPrec :: Int -> ReadS SemanticTokensLegend
Read, SemanticTokensLegend -> SemanticTokensLegend -> Bool
(SemanticTokensLegend -> SemanticTokensLegend -> Bool)
-> (SemanticTokensLegend -> SemanticTokensLegend -> Bool)
-> Eq SemanticTokensLegend
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokensLegend -> SemanticTokensLegend -> Bool
$c/= :: SemanticTokensLegend -> SemanticTokensLegend -> Bool
== :: SemanticTokensLegend -> SemanticTokensLegend -> Bool
$c== :: SemanticTokensLegend -> SemanticTokensLegend -> Bool
Eq)
deriveJSON lspOptions ''SemanticTokensLegend

-- We give a default legend which just lists the "known" types and modifiers in the order they're listed.
instance Default SemanticTokensLegend where
  def :: SemanticTokensLegend
def = List SemanticTokenTypes
-> List SemanticTokenModifiers -> SemanticTokensLegend
SemanticTokensLegend ([SemanticTokenTypes] -> List SemanticTokenTypes
forall a. [a] -> List a
List [SemanticTokenTypes]
knownSemanticTokenTypes) ([SemanticTokenModifiers] -> List SemanticTokenModifiers
forall a. [a] -> List a
List [SemanticTokenModifiers]
knownSemanticTokenModifiers)

data SemanticTokensRangeClientCapabilities = SemanticTokensRangeBool Bool | SemanticTokensRangeObj A.Value
  deriving (Int -> SemanticTokensRangeClientCapabilities -> ShowS
[SemanticTokensRangeClientCapabilities] -> ShowS
SemanticTokensRangeClientCapabilities -> String
(Int -> SemanticTokensRangeClientCapabilities -> ShowS)
-> (SemanticTokensRangeClientCapabilities -> String)
-> ([SemanticTokensRangeClientCapabilities] -> ShowS)
-> Show SemanticTokensRangeClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokensRangeClientCapabilities] -> ShowS
$cshowList :: [SemanticTokensRangeClientCapabilities] -> ShowS
show :: SemanticTokensRangeClientCapabilities -> String
$cshow :: SemanticTokensRangeClientCapabilities -> String
showsPrec :: Int -> SemanticTokensRangeClientCapabilities -> ShowS
$cshowsPrec :: Int -> SemanticTokensRangeClientCapabilities -> ShowS
Show, ReadPrec [SemanticTokensRangeClientCapabilities]
ReadPrec SemanticTokensRangeClientCapabilities
Int -> ReadS SemanticTokensRangeClientCapabilities
ReadS [SemanticTokensRangeClientCapabilities]
(Int -> ReadS SemanticTokensRangeClientCapabilities)
-> ReadS [SemanticTokensRangeClientCapabilities]
-> ReadPrec SemanticTokensRangeClientCapabilities
-> ReadPrec [SemanticTokensRangeClientCapabilities]
-> Read SemanticTokensRangeClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokensRangeClientCapabilities]
$creadListPrec :: ReadPrec [SemanticTokensRangeClientCapabilities]
readPrec :: ReadPrec SemanticTokensRangeClientCapabilities
$creadPrec :: ReadPrec SemanticTokensRangeClientCapabilities
readList :: ReadS [SemanticTokensRangeClientCapabilities]
$creadList :: ReadS [SemanticTokensRangeClientCapabilities]
readsPrec :: Int -> ReadS SemanticTokensRangeClientCapabilities
$creadsPrec :: Int -> ReadS SemanticTokensRangeClientCapabilities
Read, SemanticTokensRangeClientCapabilities
-> SemanticTokensRangeClientCapabilities -> Bool
(SemanticTokensRangeClientCapabilities
 -> SemanticTokensRangeClientCapabilities -> Bool)
-> (SemanticTokensRangeClientCapabilities
    -> SemanticTokensRangeClientCapabilities -> Bool)
-> Eq SemanticTokensRangeClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokensRangeClientCapabilities
-> SemanticTokensRangeClientCapabilities -> Bool
$c/= :: SemanticTokensRangeClientCapabilities
-> SemanticTokensRangeClientCapabilities -> Bool
== :: SemanticTokensRangeClientCapabilities
-> SemanticTokensRangeClientCapabilities -> Bool
$c== :: SemanticTokensRangeClientCapabilities
-> SemanticTokensRangeClientCapabilities -> Bool
Eq)
deriveJSON lspOptionsUntagged ''SemanticTokensRangeClientCapabilities

data SemanticTokensDeltaClientCapabilities = SemanticTokensDeltaClientCapabilities {
  -- | The client will send the `textDocument/semanticTokens/full/delta`
  -- request if the server provides a corresponding handler.
  SemanticTokensDeltaClientCapabilities -> Maybe Bool
_delta :: Maybe Bool
} deriving (Int -> SemanticTokensDeltaClientCapabilities -> ShowS
[SemanticTokensDeltaClientCapabilities] -> ShowS
SemanticTokensDeltaClientCapabilities -> String
(Int -> SemanticTokensDeltaClientCapabilities -> ShowS)
-> (SemanticTokensDeltaClientCapabilities -> String)
-> ([SemanticTokensDeltaClientCapabilities] -> ShowS)
-> Show SemanticTokensDeltaClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokensDeltaClientCapabilities] -> ShowS
$cshowList :: [SemanticTokensDeltaClientCapabilities] -> ShowS
show :: SemanticTokensDeltaClientCapabilities -> String
$cshow :: SemanticTokensDeltaClientCapabilities -> String
showsPrec :: Int -> SemanticTokensDeltaClientCapabilities -> ShowS
$cshowsPrec :: Int -> SemanticTokensDeltaClientCapabilities -> ShowS
Show, ReadPrec [SemanticTokensDeltaClientCapabilities]
ReadPrec SemanticTokensDeltaClientCapabilities
Int -> ReadS SemanticTokensDeltaClientCapabilities
ReadS [SemanticTokensDeltaClientCapabilities]
(Int -> ReadS SemanticTokensDeltaClientCapabilities)
-> ReadS [SemanticTokensDeltaClientCapabilities]
-> ReadPrec SemanticTokensDeltaClientCapabilities
-> ReadPrec [SemanticTokensDeltaClientCapabilities]
-> Read SemanticTokensDeltaClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokensDeltaClientCapabilities]
$creadListPrec :: ReadPrec [SemanticTokensDeltaClientCapabilities]
readPrec :: ReadPrec SemanticTokensDeltaClientCapabilities
$creadPrec :: ReadPrec SemanticTokensDeltaClientCapabilities
readList :: ReadS [SemanticTokensDeltaClientCapabilities]
$creadList :: ReadS [SemanticTokensDeltaClientCapabilities]
readsPrec :: Int -> ReadS SemanticTokensDeltaClientCapabilities
$creadsPrec :: Int -> ReadS SemanticTokensDeltaClientCapabilities
Read, SemanticTokensDeltaClientCapabilities
-> SemanticTokensDeltaClientCapabilities -> Bool
(SemanticTokensDeltaClientCapabilities
 -> SemanticTokensDeltaClientCapabilities -> Bool)
-> (SemanticTokensDeltaClientCapabilities
    -> SemanticTokensDeltaClientCapabilities -> Bool)
-> Eq SemanticTokensDeltaClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokensDeltaClientCapabilities
-> SemanticTokensDeltaClientCapabilities -> Bool
$c/= :: SemanticTokensDeltaClientCapabilities
-> SemanticTokensDeltaClientCapabilities -> Bool
== :: SemanticTokensDeltaClientCapabilities
-> SemanticTokensDeltaClientCapabilities -> Bool
$c== :: SemanticTokensDeltaClientCapabilities
-> SemanticTokensDeltaClientCapabilities -> Bool
Eq)
deriveJSON lspOptions ''SemanticTokensDeltaClientCapabilities

data SemanticTokensFullClientCapabilities = SemanticTokensFullBool Bool | SemanticTokensFullDelta SemanticTokensDeltaClientCapabilities
  deriving (Int -> SemanticTokensFullClientCapabilities -> ShowS
[SemanticTokensFullClientCapabilities] -> ShowS
SemanticTokensFullClientCapabilities -> String
(Int -> SemanticTokensFullClientCapabilities -> ShowS)
-> (SemanticTokensFullClientCapabilities -> String)
-> ([SemanticTokensFullClientCapabilities] -> ShowS)
-> Show SemanticTokensFullClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokensFullClientCapabilities] -> ShowS
$cshowList :: [SemanticTokensFullClientCapabilities] -> ShowS
show :: SemanticTokensFullClientCapabilities -> String
$cshow :: SemanticTokensFullClientCapabilities -> String
showsPrec :: Int -> SemanticTokensFullClientCapabilities -> ShowS
$cshowsPrec :: Int -> SemanticTokensFullClientCapabilities -> ShowS
Show, ReadPrec [SemanticTokensFullClientCapabilities]
ReadPrec SemanticTokensFullClientCapabilities
Int -> ReadS SemanticTokensFullClientCapabilities
ReadS [SemanticTokensFullClientCapabilities]
(Int -> ReadS SemanticTokensFullClientCapabilities)
-> ReadS [SemanticTokensFullClientCapabilities]
-> ReadPrec SemanticTokensFullClientCapabilities
-> ReadPrec [SemanticTokensFullClientCapabilities]
-> Read SemanticTokensFullClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokensFullClientCapabilities]
$creadListPrec :: ReadPrec [SemanticTokensFullClientCapabilities]
readPrec :: ReadPrec SemanticTokensFullClientCapabilities
$creadPrec :: ReadPrec SemanticTokensFullClientCapabilities
readList :: ReadS [SemanticTokensFullClientCapabilities]
$creadList :: ReadS [SemanticTokensFullClientCapabilities]
readsPrec :: Int -> ReadS SemanticTokensFullClientCapabilities
$creadsPrec :: Int -> ReadS SemanticTokensFullClientCapabilities
Read, SemanticTokensFullClientCapabilities
-> SemanticTokensFullClientCapabilities -> Bool
(SemanticTokensFullClientCapabilities
 -> SemanticTokensFullClientCapabilities -> Bool)
-> (SemanticTokensFullClientCapabilities
    -> SemanticTokensFullClientCapabilities -> Bool)
-> Eq SemanticTokensFullClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokensFullClientCapabilities
-> SemanticTokensFullClientCapabilities -> Bool
$c/= :: SemanticTokensFullClientCapabilities
-> SemanticTokensFullClientCapabilities -> Bool
== :: SemanticTokensFullClientCapabilities
-> SemanticTokensFullClientCapabilities -> Bool
$c== :: SemanticTokensFullClientCapabilities
-> SemanticTokensFullClientCapabilities -> Bool
Eq)
deriveJSON lspOptionsUntagged ''SemanticTokensFullClientCapabilities

data SemanticTokensRequestsClientCapabilities = SemanticTokensRequestsClientCapabilities {
  -- | The client will send the `textDocument/semanticTokens/range` request
  -- if the server provides a corresponding handler.
  SemanticTokensRequestsClientCapabilities
-> Maybe SemanticTokensRangeClientCapabilities
_range :: Maybe SemanticTokensRangeClientCapabilities,
  -- | The client will send the `textDocument/semanticTokens/full` request
  -- if the server provides a corresponding handler.
  SemanticTokensRequestsClientCapabilities
-> Maybe SemanticTokensFullClientCapabilities
_full  :: Maybe SemanticTokensFullClientCapabilities
} deriving (Int -> SemanticTokensRequestsClientCapabilities -> ShowS
[SemanticTokensRequestsClientCapabilities] -> ShowS
SemanticTokensRequestsClientCapabilities -> String
(Int -> SemanticTokensRequestsClientCapabilities -> ShowS)
-> (SemanticTokensRequestsClientCapabilities -> String)
-> ([SemanticTokensRequestsClientCapabilities] -> ShowS)
-> Show SemanticTokensRequestsClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokensRequestsClientCapabilities] -> ShowS
$cshowList :: [SemanticTokensRequestsClientCapabilities] -> ShowS
show :: SemanticTokensRequestsClientCapabilities -> String
$cshow :: SemanticTokensRequestsClientCapabilities -> String
showsPrec :: Int -> SemanticTokensRequestsClientCapabilities -> ShowS
$cshowsPrec :: Int -> SemanticTokensRequestsClientCapabilities -> ShowS
Show, ReadPrec [SemanticTokensRequestsClientCapabilities]
ReadPrec SemanticTokensRequestsClientCapabilities
Int -> ReadS SemanticTokensRequestsClientCapabilities
ReadS [SemanticTokensRequestsClientCapabilities]
(Int -> ReadS SemanticTokensRequestsClientCapabilities)
-> ReadS [SemanticTokensRequestsClientCapabilities]
-> ReadPrec SemanticTokensRequestsClientCapabilities
-> ReadPrec [SemanticTokensRequestsClientCapabilities]
-> Read SemanticTokensRequestsClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokensRequestsClientCapabilities]
$creadListPrec :: ReadPrec [SemanticTokensRequestsClientCapabilities]
readPrec :: ReadPrec SemanticTokensRequestsClientCapabilities
$creadPrec :: ReadPrec SemanticTokensRequestsClientCapabilities
readList :: ReadS [SemanticTokensRequestsClientCapabilities]
$creadList :: ReadS [SemanticTokensRequestsClientCapabilities]
readsPrec :: Int -> ReadS SemanticTokensRequestsClientCapabilities
$creadsPrec :: Int -> ReadS SemanticTokensRequestsClientCapabilities
Read, SemanticTokensRequestsClientCapabilities
-> SemanticTokensRequestsClientCapabilities -> Bool
(SemanticTokensRequestsClientCapabilities
 -> SemanticTokensRequestsClientCapabilities -> Bool)
-> (SemanticTokensRequestsClientCapabilities
    -> SemanticTokensRequestsClientCapabilities -> Bool)
-> Eq SemanticTokensRequestsClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokensRequestsClientCapabilities
-> SemanticTokensRequestsClientCapabilities -> Bool
$c/= :: SemanticTokensRequestsClientCapabilities
-> SemanticTokensRequestsClientCapabilities -> Bool
== :: SemanticTokensRequestsClientCapabilities
-> SemanticTokensRequestsClientCapabilities -> Bool
$c== :: SemanticTokensRequestsClientCapabilities
-> SemanticTokensRequestsClientCapabilities -> Bool
Eq)
deriveJSON lspOptions ''SemanticTokensRequestsClientCapabilities

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
-> SemanticTokensRequestsClientCapabilities
_requests                :: SemanticTokensRequestsClientCapabilities,

  -- | The token types that the client supports.
  SemanticTokensClientCapabilities -> List SemanticTokenTypes
_tokenTypes              :: List SemanticTokenTypes,

  -- | The token modifiers that the client supports.
  SemanticTokensClientCapabilities -> List SemanticTokenModifiers
_tokenModifiers          :: List SemanticTokenModifiers,

  -- | The formats the clients supports.
  SemanticTokensClientCapabilities -> List TokenFormat
_formats                 :: List 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
} deriving (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
showList :: [SemanticTokensClientCapabilities] -> ShowS
$cshowList :: [SemanticTokensClientCapabilities] -> ShowS
show :: SemanticTokensClientCapabilities -> String
$cshow :: SemanticTokensClientCapabilities -> String
showsPrec :: Int -> SemanticTokensClientCapabilities -> ShowS
$cshowsPrec :: Int -> SemanticTokensClientCapabilities -> ShowS
Show, ReadPrec [SemanticTokensClientCapabilities]
ReadPrec SemanticTokensClientCapabilities
Int -> ReadS SemanticTokensClientCapabilities
ReadS [SemanticTokensClientCapabilities]
(Int -> ReadS SemanticTokensClientCapabilities)
-> ReadS [SemanticTokensClientCapabilities]
-> ReadPrec SemanticTokensClientCapabilities
-> ReadPrec [SemanticTokensClientCapabilities]
-> Read SemanticTokensClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokensClientCapabilities]
$creadListPrec :: ReadPrec [SemanticTokensClientCapabilities]
readPrec :: ReadPrec SemanticTokensClientCapabilities
$creadPrec :: ReadPrec SemanticTokensClientCapabilities
readList :: ReadS [SemanticTokensClientCapabilities]
$creadList :: ReadS [SemanticTokensClientCapabilities]
readsPrec :: Int -> ReadS SemanticTokensClientCapabilities
$creadsPrec :: Int -> ReadS SemanticTokensClientCapabilities
Read, SemanticTokensClientCapabilities
-> SemanticTokensClientCapabilities -> Bool
(SemanticTokensClientCapabilities
 -> SemanticTokensClientCapabilities -> Bool)
-> (SemanticTokensClientCapabilities
    -> SemanticTokensClientCapabilities -> Bool)
-> Eq SemanticTokensClientCapabilities
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)
deriveJSON lspOptions ''SemanticTokensClientCapabilities

makeExtendingDatatype "SemanticTokensOptions" [''WorkDoneProgressOptions]
  [ ("_legend", [t| SemanticTokensLegend |])
  , ("_range", [t| Maybe SemanticTokensRangeClientCapabilities |])
  , ("_full", [t| Maybe SemanticTokensFullClientCapabilities |])
  ]
deriveJSON lspOptions ''SemanticTokensOptions

makeExtendingDatatype "SemanticTokensRegistrationOptions"
  [ ''TextDocumentRegistrationOptions
  , ''SemanticTokensOptions
  , ''StaticRegistrationOptions] []
deriveJSON lspOptions ''SemanticTokensRegistrationOptions

makeExtendingDatatype "SemanticTokensParams"
  [''WorkDoneProgressParams
  , ''PartialResultParams]
  [ ("_textDocument", [t| TextDocumentIdentifier |]) ]
deriveJSON lspOptions ''SemanticTokensParams

data SemanticTokens = SemanticTokens {
  -- | An optional result id. If provided and clients support delta updating
  -- the client will include the result id in the next semantic token request.
  -- A server can then instead of computing all semantic tokens again simply
  -- send a delta.
  SemanticTokens -> Maybe Text
_resultId :: Maybe Text,

  -- | The actual tokens.
  SemanticTokens -> List Int
_xdata    :: List Int
} deriving (Int -> SemanticTokens -> ShowS
[SemanticTokens] -> ShowS
SemanticTokens -> String
(Int -> SemanticTokens -> ShowS)
-> (SemanticTokens -> String)
-> ([SemanticTokens] -> ShowS)
-> Show SemanticTokens
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokens] -> ShowS
$cshowList :: [SemanticTokens] -> ShowS
show :: SemanticTokens -> String
$cshow :: SemanticTokens -> String
showsPrec :: Int -> SemanticTokens -> ShowS
$cshowsPrec :: Int -> SemanticTokens -> ShowS
Show, ReadPrec [SemanticTokens]
ReadPrec SemanticTokens
Int -> ReadS SemanticTokens
ReadS [SemanticTokens]
(Int -> ReadS SemanticTokens)
-> ReadS [SemanticTokens]
-> ReadPrec SemanticTokens
-> ReadPrec [SemanticTokens]
-> Read SemanticTokens
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokens]
$creadListPrec :: ReadPrec [SemanticTokens]
readPrec :: ReadPrec SemanticTokens
$creadPrec :: ReadPrec SemanticTokens
readList :: ReadS [SemanticTokens]
$creadList :: ReadS [SemanticTokens]
readsPrec :: Int -> ReadS SemanticTokens
$creadsPrec :: Int -> ReadS SemanticTokens
Read, SemanticTokens -> SemanticTokens -> Bool
(SemanticTokens -> SemanticTokens -> Bool)
-> (SemanticTokens -> SemanticTokens -> Bool) -> Eq SemanticTokens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokens -> SemanticTokens -> Bool
$c/= :: SemanticTokens -> SemanticTokens -> Bool
== :: SemanticTokens -> SemanticTokens -> Bool
$c== :: SemanticTokens -> SemanticTokens -> Bool
Eq)
deriveJSON lspOptions ''SemanticTokens

data SemanticTokensPartialResult = SemanticTokensPartialResult {
  SemanticTokensPartialResult -> List Int
_xdata :: List Int
}
deriveJSON lspOptions ''SemanticTokensPartialResult

makeExtendingDatatype "SemanticTokensDeltaParams"
  [''WorkDoneProgressParams
  , ''PartialResultParams]
  [ ("_textDocument", [t| TextDocumentIdentifier  |])
  , ("_previousResultId", [t| Text |])
  ]
deriveJSON lspOptions ''SemanticTokensDeltaParams

data SemanticTokensEdit = SemanticTokensEdit {
  -- | The start offset of the edit.
  SemanticTokensEdit -> Int
_start       :: Int,
  -- | The count of elements to remove.
  SemanticTokensEdit -> Int
_deleteCount :: Int,
  -- | The elements to insert.
  SemanticTokensEdit -> Maybe (List Int)
_xdata       :: Maybe (List Int)
} deriving (Int -> SemanticTokensEdit -> ShowS
[SemanticTokensEdit] -> ShowS
SemanticTokensEdit -> String
(Int -> SemanticTokensEdit -> ShowS)
-> (SemanticTokensEdit -> String)
-> ([SemanticTokensEdit] -> ShowS)
-> Show SemanticTokensEdit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokensEdit] -> ShowS
$cshowList :: [SemanticTokensEdit] -> ShowS
show :: SemanticTokensEdit -> String
$cshow :: SemanticTokensEdit -> String
showsPrec :: Int -> SemanticTokensEdit -> ShowS
$cshowsPrec :: Int -> SemanticTokensEdit -> ShowS
Show, ReadPrec [SemanticTokensEdit]
ReadPrec SemanticTokensEdit
Int -> ReadS SemanticTokensEdit
ReadS [SemanticTokensEdit]
(Int -> ReadS SemanticTokensEdit)
-> ReadS [SemanticTokensEdit]
-> ReadPrec SemanticTokensEdit
-> ReadPrec [SemanticTokensEdit]
-> Read SemanticTokensEdit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokensEdit]
$creadListPrec :: ReadPrec [SemanticTokensEdit]
readPrec :: ReadPrec SemanticTokensEdit
$creadPrec :: ReadPrec SemanticTokensEdit
readList :: ReadS [SemanticTokensEdit]
$creadList :: ReadS [SemanticTokensEdit]
readsPrec :: Int -> ReadS SemanticTokensEdit
$creadsPrec :: Int -> ReadS SemanticTokensEdit
Read, SemanticTokensEdit -> SemanticTokensEdit -> Bool
(SemanticTokensEdit -> SemanticTokensEdit -> Bool)
-> (SemanticTokensEdit -> SemanticTokensEdit -> Bool)
-> Eq SemanticTokensEdit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokensEdit -> SemanticTokensEdit -> Bool
$c/= :: SemanticTokensEdit -> SemanticTokensEdit -> Bool
== :: SemanticTokensEdit -> SemanticTokensEdit -> Bool
$c== :: SemanticTokensEdit -> SemanticTokensEdit -> Bool
Eq)
deriveJSON lspOptions ''SemanticTokensEdit

data SemanticTokensDelta = SemanticTokensDelta {
  SemanticTokensDelta -> Maybe Text
_resultId :: Maybe Text,
  -- | The semantic token edits to transform a previous result into a new
  -- result.
  SemanticTokensDelta -> List SemanticTokensEdit
_edits    :: List SemanticTokensEdit
} deriving (Int -> SemanticTokensDelta -> ShowS
[SemanticTokensDelta] -> ShowS
SemanticTokensDelta -> String
(Int -> SemanticTokensDelta -> ShowS)
-> (SemanticTokensDelta -> String)
-> ([SemanticTokensDelta] -> ShowS)
-> Show SemanticTokensDelta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokensDelta] -> ShowS
$cshowList :: [SemanticTokensDelta] -> ShowS
show :: SemanticTokensDelta -> String
$cshow :: SemanticTokensDelta -> String
showsPrec :: Int -> SemanticTokensDelta -> ShowS
$cshowsPrec :: Int -> SemanticTokensDelta -> ShowS
Show, ReadPrec [SemanticTokensDelta]
ReadPrec SemanticTokensDelta
Int -> ReadS SemanticTokensDelta
ReadS [SemanticTokensDelta]
(Int -> ReadS SemanticTokensDelta)
-> ReadS [SemanticTokensDelta]
-> ReadPrec SemanticTokensDelta
-> ReadPrec [SemanticTokensDelta]
-> Read SemanticTokensDelta
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokensDelta]
$creadListPrec :: ReadPrec [SemanticTokensDelta]
readPrec :: ReadPrec SemanticTokensDelta
$creadPrec :: ReadPrec SemanticTokensDelta
readList :: ReadS [SemanticTokensDelta]
$creadList :: ReadS [SemanticTokensDelta]
readsPrec :: Int -> ReadS SemanticTokensDelta
$creadsPrec :: Int -> ReadS SemanticTokensDelta
Read, SemanticTokensDelta -> SemanticTokensDelta -> Bool
(SemanticTokensDelta -> SemanticTokensDelta -> Bool)
-> (SemanticTokensDelta -> SemanticTokensDelta -> Bool)
-> Eq SemanticTokensDelta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokensDelta -> SemanticTokensDelta -> Bool
$c/= :: SemanticTokensDelta -> SemanticTokensDelta -> Bool
== :: SemanticTokensDelta -> SemanticTokensDelta -> Bool
$c== :: SemanticTokensDelta -> SemanticTokensDelta -> Bool
Eq)
deriveJSON lspOptions ''SemanticTokensDelta

data SemanticTokensDeltaPartialResult = SemantictokensDeltaPartialResult {
  SemanticTokensDeltaPartialResult -> List SemanticTokensEdit
_edits :: List SemanticTokensEdit
} deriving (Int -> SemanticTokensDeltaPartialResult -> ShowS
[SemanticTokensDeltaPartialResult] -> ShowS
SemanticTokensDeltaPartialResult -> String
(Int -> SemanticTokensDeltaPartialResult -> ShowS)
-> (SemanticTokensDeltaPartialResult -> String)
-> ([SemanticTokensDeltaPartialResult] -> ShowS)
-> Show SemanticTokensDeltaPartialResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokensDeltaPartialResult] -> ShowS
$cshowList :: [SemanticTokensDeltaPartialResult] -> ShowS
show :: SemanticTokensDeltaPartialResult -> String
$cshow :: SemanticTokensDeltaPartialResult -> String
showsPrec :: Int -> SemanticTokensDeltaPartialResult -> ShowS
$cshowsPrec :: Int -> SemanticTokensDeltaPartialResult -> ShowS
Show, ReadPrec [SemanticTokensDeltaPartialResult]
ReadPrec SemanticTokensDeltaPartialResult
Int -> ReadS SemanticTokensDeltaPartialResult
ReadS [SemanticTokensDeltaPartialResult]
(Int -> ReadS SemanticTokensDeltaPartialResult)
-> ReadS [SemanticTokensDeltaPartialResult]
-> ReadPrec SemanticTokensDeltaPartialResult
-> ReadPrec [SemanticTokensDeltaPartialResult]
-> Read SemanticTokensDeltaPartialResult
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokensDeltaPartialResult]
$creadListPrec :: ReadPrec [SemanticTokensDeltaPartialResult]
readPrec :: ReadPrec SemanticTokensDeltaPartialResult
$creadPrec :: ReadPrec SemanticTokensDeltaPartialResult
readList :: ReadS [SemanticTokensDeltaPartialResult]
$creadList :: ReadS [SemanticTokensDeltaPartialResult]
readsPrec :: Int -> ReadS SemanticTokensDeltaPartialResult
$creadsPrec :: Int -> ReadS SemanticTokensDeltaPartialResult
Read, SemanticTokensDeltaPartialResult
-> SemanticTokensDeltaPartialResult -> Bool
(SemanticTokensDeltaPartialResult
 -> SemanticTokensDeltaPartialResult -> Bool)
-> (SemanticTokensDeltaPartialResult
    -> SemanticTokensDeltaPartialResult -> Bool)
-> Eq SemanticTokensDeltaPartialResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokensDeltaPartialResult
-> SemanticTokensDeltaPartialResult -> Bool
$c/= :: SemanticTokensDeltaPartialResult
-> SemanticTokensDeltaPartialResult -> Bool
== :: SemanticTokensDeltaPartialResult
-> SemanticTokensDeltaPartialResult -> Bool
$c== :: SemanticTokensDeltaPartialResult
-> SemanticTokensDeltaPartialResult -> Bool
Eq)
deriveJSON lspOptions ''SemanticTokensDeltaPartialResult

makeExtendingDatatype "SemanticTokensRangeParams"
  [''WorkDoneProgressParams
  , ''PartialResultParams]
  [ ("_textDocument", [t| TextDocumentIdentifier  |])
  , ("_range", [t| Range |])
  ]
deriveJSON lspOptions ''SemanticTokensRangeParams

data SemanticTokensWorkspaceClientCapabilities = SemanticTokensWorkspaceClientCapabilities {
  -- | Whether the client implementation supports a refresh request sent from
  -- the server to the client.
  --
  -- Note that this event is global and will force the client to refresh all
  -- semantic tokens currently shown. It should be used with absolute care
  -- and is useful for situation where a server for example detect a project
  -- wide change that requires such a calculation.
  SemanticTokensWorkspaceClientCapabilities -> Maybe Bool
_refreshSupport :: Maybe Bool
} deriving (Int -> SemanticTokensWorkspaceClientCapabilities -> ShowS
[SemanticTokensWorkspaceClientCapabilities] -> ShowS
SemanticTokensWorkspaceClientCapabilities -> String
(Int -> SemanticTokensWorkspaceClientCapabilities -> ShowS)
-> (SemanticTokensWorkspaceClientCapabilities -> String)
-> ([SemanticTokensWorkspaceClientCapabilities] -> ShowS)
-> Show SemanticTokensWorkspaceClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokensWorkspaceClientCapabilities] -> ShowS
$cshowList :: [SemanticTokensWorkspaceClientCapabilities] -> ShowS
show :: SemanticTokensWorkspaceClientCapabilities -> String
$cshow :: SemanticTokensWorkspaceClientCapabilities -> String
showsPrec :: Int -> SemanticTokensWorkspaceClientCapabilities -> ShowS
$cshowsPrec :: Int -> SemanticTokensWorkspaceClientCapabilities -> ShowS
Show, ReadPrec [SemanticTokensWorkspaceClientCapabilities]
ReadPrec SemanticTokensWorkspaceClientCapabilities
Int -> ReadS SemanticTokensWorkspaceClientCapabilities
ReadS [SemanticTokensWorkspaceClientCapabilities]
(Int -> ReadS SemanticTokensWorkspaceClientCapabilities)
-> ReadS [SemanticTokensWorkspaceClientCapabilities]
-> ReadPrec SemanticTokensWorkspaceClientCapabilities
-> ReadPrec [SemanticTokensWorkspaceClientCapabilities]
-> Read SemanticTokensWorkspaceClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokensWorkspaceClientCapabilities]
$creadListPrec :: ReadPrec [SemanticTokensWorkspaceClientCapabilities]
readPrec :: ReadPrec SemanticTokensWorkspaceClientCapabilities
$creadPrec :: ReadPrec SemanticTokensWorkspaceClientCapabilities
readList :: ReadS [SemanticTokensWorkspaceClientCapabilities]
$creadList :: ReadS [SemanticTokensWorkspaceClientCapabilities]
readsPrec :: Int -> ReadS SemanticTokensWorkspaceClientCapabilities
$creadsPrec :: Int -> ReadS SemanticTokensWorkspaceClientCapabilities
Read, SemanticTokensWorkspaceClientCapabilities
-> SemanticTokensWorkspaceClientCapabilities -> Bool
(SemanticTokensWorkspaceClientCapabilities
 -> SemanticTokensWorkspaceClientCapabilities -> Bool)
-> (SemanticTokensWorkspaceClientCapabilities
    -> SemanticTokensWorkspaceClientCapabilities -> Bool)
-> Eq SemanticTokensWorkspaceClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokensWorkspaceClientCapabilities
-> SemanticTokensWorkspaceClientCapabilities -> Bool
$c/= :: SemanticTokensWorkspaceClientCapabilities
-> SemanticTokensWorkspaceClientCapabilities -> Bool
== :: SemanticTokensWorkspaceClientCapabilities
-> SemanticTokensWorkspaceClientCapabilities -> Bool
$c== :: SemanticTokensWorkspaceClientCapabilities
-> SemanticTokensWorkspaceClientCapabilities -> Bool
Eq)
deriveJSON lspOptions ''SemanticTokensWorkspaceClientCapabilities

----------------------------------------------------------
-- Tools for working with semantic tokens.
----------------------------------------------------------

-- | A single 'semantic token' as described in the LSP specification, using absolute positions.
-- This is the kind of token that is usually easiest for editors to produce.
data SemanticTokenAbsolute = SemanticTokenAbsolute {
  SemanticTokenAbsolute -> Int
line           :: Int,
  SemanticTokenAbsolute -> Int
startChar      :: Int,
  SemanticTokenAbsolute -> Int
length         :: Int,
  SemanticTokenAbsolute -> SemanticTokenTypes
tokenType      :: SemanticTokenTypes,
  SemanticTokenAbsolute -> [SemanticTokenModifiers]
tokenModifiers :: [SemanticTokenModifiers]
} deriving (Int -> SemanticTokenAbsolute -> ShowS
[SemanticTokenAbsolute] -> ShowS
SemanticTokenAbsolute -> String
(Int -> SemanticTokenAbsolute -> ShowS)
-> (SemanticTokenAbsolute -> String)
-> ([SemanticTokenAbsolute] -> ShowS)
-> Show SemanticTokenAbsolute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokenAbsolute] -> ShowS
$cshowList :: [SemanticTokenAbsolute] -> ShowS
show :: SemanticTokenAbsolute -> String
$cshow :: SemanticTokenAbsolute -> String
showsPrec :: Int -> SemanticTokenAbsolute -> ShowS
$cshowsPrec :: Int -> SemanticTokenAbsolute -> ShowS
Show, ReadPrec [SemanticTokenAbsolute]
ReadPrec SemanticTokenAbsolute
Int -> ReadS SemanticTokenAbsolute
ReadS [SemanticTokenAbsolute]
(Int -> ReadS SemanticTokenAbsolute)
-> ReadS [SemanticTokenAbsolute]
-> ReadPrec SemanticTokenAbsolute
-> ReadPrec [SemanticTokenAbsolute]
-> Read SemanticTokenAbsolute
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokenAbsolute]
$creadListPrec :: ReadPrec [SemanticTokenAbsolute]
readPrec :: ReadPrec SemanticTokenAbsolute
$creadPrec :: ReadPrec SemanticTokenAbsolute
readList :: ReadS [SemanticTokenAbsolute]
$creadList :: ReadS [SemanticTokenAbsolute]
readsPrec :: Int -> ReadS SemanticTokenAbsolute
$creadsPrec :: Int -> ReadS SemanticTokenAbsolute
Read, SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
(SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool)
-> (SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool)
-> Eq SemanticTokenAbsolute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
$c/= :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
== :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
$c== :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
Eq, Eq SemanticTokenAbsolute
Eq SemanticTokenAbsolute
-> (SemanticTokenAbsolute -> SemanticTokenAbsolute -> Ordering)
-> (SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool)
-> (SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool)
-> (SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool)
-> (SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool)
-> (SemanticTokenAbsolute
    -> SemanticTokenAbsolute -> SemanticTokenAbsolute)
-> (SemanticTokenAbsolute
    -> SemanticTokenAbsolute -> SemanticTokenAbsolute)
-> Ord SemanticTokenAbsolute
SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
SemanticTokenAbsolute -> SemanticTokenAbsolute -> Ordering
SemanticTokenAbsolute
-> SemanticTokenAbsolute -> SemanticTokenAbsolute
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 :: SemanticTokenAbsolute
-> SemanticTokenAbsolute -> SemanticTokenAbsolute
$cmin :: SemanticTokenAbsolute
-> SemanticTokenAbsolute -> SemanticTokenAbsolute
max :: SemanticTokenAbsolute
-> SemanticTokenAbsolute -> SemanticTokenAbsolute
$cmax :: SemanticTokenAbsolute
-> SemanticTokenAbsolute -> SemanticTokenAbsolute
>= :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
$c>= :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
> :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
$c> :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
<= :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
$c<= :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
< :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
$c< :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
compare :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Ordering
$ccompare :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Ordering
$cp1Ord :: Eq SemanticTokenAbsolute
Ord)
-- Note: we want the Ord instance to sort the tokens textually: this is achieved due to the
-- order of the constructors

-- | A single 'semantic token' as described in the LSP specification, using relative positions.
data SemanticTokenRelative = SemanticTokenRelative {
  SemanticTokenRelative -> Int
deltaLine      :: Int,
  SemanticTokenRelative -> Int
deltaStartChar :: Int,
  SemanticTokenRelative -> Int
length         :: Int,
  SemanticTokenRelative -> SemanticTokenTypes
tokenType      :: SemanticTokenTypes,
  SemanticTokenRelative -> [SemanticTokenModifiers]
tokenModifiers :: [SemanticTokenModifiers]
} deriving (Int -> SemanticTokenRelative -> ShowS
[SemanticTokenRelative] -> ShowS
SemanticTokenRelative -> String
(Int -> SemanticTokenRelative -> ShowS)
-> (SemanticTokenRelative -> String)
-> ([SemanticTokenRelative] -> ShowS)
-> Show SemanticTokenRelative
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokenRelative] -> ShowS
$cshowList :: [SemanticTokenRelative] -> ShowS
show :: SemanticTokenRelative -> String
$cshow :: SemanticTokenRelative -> String
showsPrec :: Int -> SemanticTokenRelative -> ShowS
$cshowsPrec :: Int -> SemanticTokenRelative -> ShowS
Show, ReadPrec [SemanticTokenRelative]
ReadPrec SemanticTokenRelative
Int -> ReadS SemanticTokenRelative
ReadS [SemanticTokenRelative]
(Int -> ReadS SemanticTokenRelative)
-> ReadS [SemanticTokenRelative]
-> ReadPrec SemanticTokenRelative
-> ReadPrec [SemanticTokenRelative]
-> Read SemanticTokenRelative
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SemanticTokenRelative]
$creadListPrec :: ReadPrec [SemanticTokenRelative]
readPrec :: ReadPrec SemanticTokenRelative
$creadPrec :: ReadPrec SemanticTokenRelative
readList :: ReadS [SemanticTokenRelative]
$creadList :: ReadS [SemanticTokenRelative]
readsPrec :: Int -> ReadS SemanticTokenRelative
$creadsPrec :: Int -> ReadS SemanticTokenRelative
Read, SemanticTokenRelative -> SemanticTokenRelative -> Bool
(SemanticTokenRelative -> SemanticTokenRelative -> Bool)
-> (SemanticTokenRelative -> SemanticTokenRelative -> Bool)
-> Eq SemanticTokenRelative
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
$c/= :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
== :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
$c== :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
Eq, Eq SemanticTokenRelative
Eq SemanticTokenRelative
-> (SemanticTokenRelative -> SemanticTokenRelative -> Ordering)
-> (SemanticTokenRelative -> SemanticTokenRelative -> Bool)
-> (SemanticTokenRelative -> SemanticTokenRelative -> Bool)
-> (SemanticTokenRelative -> SemanticTokenRelative -> Bool)
-> (SemanticTokenRelative -> SemanticTokenRelative -> Bool)
-> (SemanticTokenRelative
    -> SemanticTokenRelative -> SemanticTokenRelative)
-> (SemanticTokenRelative
    -> SemanticTokenRelative -> SemanticTokenRelative)
-> Ord SemanticTokenRelative
SemanticTokenRelative -> SemanticTokenRelative -> Bool
SemanticTokenRelative -> SemanticTokenRelative -> Ordering
SemanticTokenRelative
-> SemanticTokenRelative -> SemanticTokenRelative
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 :: SemanticTokenRelative
-> SemanticTokenRelative -> SemanticTokenRelative
$cmin :: SemanticTokenRelative
-> SemanticTokenRelative -> SemanticTokenRelative
max :: SemanticTokenRelative
-> SemanticTokenRelative -> SemanticTokenRelative
$cmax :: SemanticTokenRelative
-> SemanticTokenRelative -> SemanticTokenRelative
>= :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
$c>= :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
> :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
$c> :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
<= :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
$c<= :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
< :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
$c< :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
compare :: SemanticTokenRelative -> SemanticTokenRelative -> Ordering
$ccompare :: SemanticTokenRelative -> SemanticTokenRelative -> Ordering
$cp1Ord :: Eq SemanticTokenRelative
Ord)
-- Note: we want the Ord instance to sort the tokens textually: this is achieved due to the
-- order of the constructors

-- | Turn a list of absolutely-positioned tokens into a list of relatively-positioned tokens. The tokens are assumed to be in the
-- order that they appear in the document!
relativizeTokens :: [SemanticTokenAbsolute] -> [SemanticTokenRelative]
relativizeTokens :: [SemanticTokenAbsolute] -> [SemanticTokenRelative]
relativizeTokens [SemanticTokenAbsolute]
xs = DList SemanticTokenRelative -> [SemanticTokenRelative]
forall a. DList a -> [a]
DList.toList (DList SemanticTokenRelative -> [SemanticTokenRelative])
-> DList SemanticTokenRelative -> [SemanticTokenRelative]
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> [SemanticTokenAbsolute]
-> DList SemanticTokenRelative
-> DList SemanticTokenRelative
go Int
0 Int
0 [SemanticTokenAbsolute]
xs DList SemanticTokenRelative
forall a. Monoid a => a
mempty
  where
    -- Pass an accumulator to make this tail-recursive
    go :: Int -> Int -> [SemanticTokenAbsolute] -> DList.DList SemanticTokenRelative -> DList.DList SemanticTokenRelative
    go :: Int
-> Int
-> [SemanticTokenAbsolute]
-> DList SemanticTokenRelative
-> DList SemanticTokenRelative
go Int
_ Int
_ [] DList SemanticTokenRelative
acc = DList SemanticTokenRelative
acc
    go Int
lastLine Int
lastChar (SemanticTokenAbsolute Int
l Int
c Int
len SemanticTokenTypes
ty [SemanticTokenModifiers]
mods:[SemanticTokenAbsolute]
ts) DList SemanticTokenRelative
acc =
      let
        lastCharInLine :: Int
lastCharInLine = if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lastLine then Int
lastChar else Int
0
        dl :: Int
dl = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lastLine
        dc :: Int
dc = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lastCharInLine
      in Int
-> Int
-> [SemanticTokenAbsolute]
-> DList SemanticTokenRelative
-> DList SemanticTokenRelative
go Int
l Int
c [SemanticTokenAbsolute]
ts (DList SemanticTokenRelative
-> SemanticTokenRelative -> DList SemanticTokenRelative
forall a. DList a -> a -> DList a
DList.snoc DList SemanticTokenRelative
acc (Int
-> Int
-> Int
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> SemanticTokenRelative
SemanticTokenRelative Int
dl Int
dc Int
len SemanticTokenTypes
ty [SemanticTokenModifiers]
mods))

-- | Turn a list of relatively-positioned tokens into a list of absolutely-positioned tokens. The tokens are assumed to be in the
-- order that they appear in the document!
absolutizeTokens :: [SemanticTokenRelative] -> [SemanticTokenAbsolute]
absolutizeTokens :: [SemanticTokenRelative] -> [SemanticTokenAbsolute]
absolutizeTokens [SemanticTokenRelative]
xs = DList SemanticTokenAbsolute -> [SemanticTokenAbsolute]
forall a. DList a -> [a]
DList.toList (DList SemanticTokenAbsolute -> [SemanticTokenAbsolute])
-> DList SemanticTokenAbsolute -> [SemanticTokenAbsolute]
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> [SemanticTokenRelative]
-> DList SemanticTokenAbsolute
-> DList SemanticTokenAbsolute
go Int
0 Int
0 [SemanticTokenRelative]
xs DList SemanticTokenAbsolute
forall a. Monoid a => a
mempty
  where
    -- Pass an accumulator to make this tail-recursive
    go :: Int -> Int -> [SemanticTokenRelative] -> DList.DList SemanticTokenAbsolute -> DList.DList SemanticTokenAbsolute
    go :: Int
-> Int
-> [SemanticTokenRelative]
-> DList SemanticTokenAbsolute
-> DList SemanticTokenAbsolute
go Int
_ Int
_ [] DList SemanticTokenAbsolute
acc = DList SemanticTokenAbsolute
acc
    go Int
lastLine Int
lastChar (SemanticTokenRelative Int
dl Int
dc Int
len SemanticTokenTypes
ty [SemanticTokenModifiers]
mods:[SemanticTokenRelative]
ts) DList SemanticTokenAbsolute
acc =
      let
        lastCharInLine :: Int
lastCharInLine = if Int
dl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
lastChar else Int
0
        l :: Int
l = Int
lastLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dl
        c :: Int
c = Int
lastCharInLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dc
      in Int
-> Int
-> [SemanticTokenRelative]
-> DList SemanticTokenAbsolute
-> DList SemanticTokenAbsolute
go Int
l Int
c [SemanticTokenRelative]
ts (DList SemanticTokenAbsolute
-> SemanticTokenAbsolute -> DList SemanticTokenAbsolute
forall a. DList a -> a -> DList a
DList.snoc DList SemanticTokenAbsolute
acc (Int
-> Int
-> Int
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> SemanticTokenAbsolute
SemanticTokenAbsolute Int
l Int
c Int
len SemanticTokenTypes
ty [SemanticTokenModifiers]
mods))

-- | Encode a series of relatively-positioned semantic tokens into an integer array following the given legend.
encodeTokens :: SemanticTokensLegend -> [SemanticTokenRelative] -> Either Text [Int]
encodeTokens :: SemanticTokensLegend
-> [SemanticTokenRelative] -> Either Text [Int]
encodeTokens SemanticTokensLegend{$sel:_tokenTypes:SemanticTokensLegend :: SemanticTokensLegend -> List SemanticTokenTypes
_tokenTypes=List [SemanticTokenTypes]
tts,$sel:_tokenModifiers:SemanticTokensLegend :: SemanticTokensLegend -> List SemanticTokenModifiers
_tokenModifiers=List [SemanticTokenModifiers]
tms} [SemanticTokenRelative]
sts =
  DList Int -> [Int]
forall a. DList a -> [a]
DList.toList (DList Int -> [Int])
-> ([DList Int] -> DList Int) -> [DList Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DList Int] -> DList Int
forall a. [DList a] -> DList a
DList.concat ([DList Int] -> [Int])
-> Either Text [DList Int] -> Either Text [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SemanticTokenRelative -> Either Text (DList Int))
-> [SemanticTokenRelative] -> Either Text [DList Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SemanticTokenRelative -> Either Text (DList Int)
encodeToken [SemanticTokenRelative]
sts
  where
    -- Note that there's no "fast" version of these (e.g. backed by an IntMap or similar)
    -- in general, due to the possibility  of unknown token types which are only identified by strings.
    tyMap :: Map.Map SemanticTokenTypes Int
    tyMap :: Map SemanticTokenTypes Int
tyMap = [(SemanticTokenTypes, Int)] -> Map SemanticTokenTypes Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(SemanticTokenTypes, Int)] -> Map SemanticTokenTypes Int)
-> [(SemanticTokenTypes, Int)] -> Map SemanticTokenTypes Int
forall a b. (a -> b) -> a -> b
$ [SemanticTokenTypes] -> [Int] -> [(SemanticTokenTypes, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SemanticTokenTypes]
tts [Item [Int]
0..]
    modMap :: Map.Map SemanticTokenModifiers Int
    modMap :: Map SemanticTokenModifiers Int
modMap = [(SemanticTokenModifiers, Int)] -> Map SemanticTokenModifiers Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(SemanticTokenModifiers, Int)] -> Map SemanticTokenModifiers Int)
-> [(SemanticTokenModifiers, Int)]
-> Map SemanticTokenModifiers Int
forall a b. (a -> b) -> a -> b
$ [SemanticTokenModifiers]
-> [Int] -> [(SemanticTokenModifiers, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SemanticTokenModifiers]
tms [Item [Int]
0..]

    lookupTy :: SemanticTokenTypes -> Either Text Int
    lookupTy :: SemanticTokenTypes -> Either Text Int
lookupTy SemanticTokenTypes
ty = case SemanticTokenTypes -> Map SemanticTokenTypes Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SemanticTokenTypes
ty Map SemanticTokenTypes Int
tyMap of
        Just Int
tycode -> Int -> Either Text Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
tycode
        Maybe Int
Nothing -> Text -> Either Text Int
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> Either Text Int) -> Text -> Either Text Int
forall a b. (a -> b) -> a -> b
$ Text
"Semantic token type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString (SemanticTokenTypes -> String
forall a. Show a => a -> String
show SemanticTokenTypes
ty) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" did not appear in the legend"
    lookupMod :: SemanticTokenModifiers -> Either Text Int
    lookupMod :: SemanticTokenModifiers -> Either Text Int
lookupMod SemanticTokenModifiers
modifier = case SemanticTokenModifiers
-> Map SemanticTokenModifiers Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SemanticTokenModifiers
modifier Map SemanticTokenModifiers Int
modMap of
        Just Int
modcode -> Int -> Either Text Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
modcode
        Maybe Int
Nothing -> Text -> Either Text Int
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> Either Text Int) -> Text -> Either Text Int
forall a b. (a -> b) -> a -> b
$ Text
"Semantic token modifier " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString (SemanticTokenModifiers -> String
forall a. Show a => a -> String
show SemanticTokenModifiers
modifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" did not appear in the legend"

    -- Use a DList here for better efficiency when concatenating all these together
    encodeToken :: SemanticTokenRelative -> Either Text (DList.DList Int)
    encodeToken :: SemanticTokenRelative -> Either Text (DList Int)
encodeToken (SemanticTokenRelative Int
dl Int
dc Int
len SemanticTokenTypes
ty [SemanticTokenModifiers]
mods) = do
      Int
tycode <- SemanticTokenTypes -> Either Text Int
lookupTy SemanticTokenTypes
ty
      [Int]
modcodes <- (SemanticTokenModifiers -> Either Text Int)
-> [SemanticTokenModifiers] -> Either Text [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SemanticTokenModifiers -> Either Text Int
lookupMod [SemanticTokenModifiers]
mods
      let combinedModcode :: Int
combinedModcode = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Bits a => a -> Int -> a
Bits.setBit Int
forall a. Bits a => a
Bits.zeroBits [Int]
modcodes

      DList Int -> Either Text (DList Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Int
Item (DList Int)
dl, Int
Item (DList Int)
dc, Int
Item (DList Int)
len, Int
Item (DList Int)
tycode, Int
Item (DList Int)
combinedModcode ]

-- This is basically 'SemanticTokensEdit', but slightly easier to work with.
-- | An edit to a buffer of items. 
data Edit a = Edit { Edit a -> Int
editStart :: Int, Edit a -> Int
editDeleteCount :: Int, Edit a -> [a]
editInsertions :: [a] }
  deriving (ReadPrec [Edit a]
ReadPrec (Edit a)
Int -> ReadS (Edit a)
ReadS [Edit a]
(Int -> ReadS (Edit a))
-> ReadS [Edit a]
-> ReadPrec (Edit a)
-> ReadPrec [Edit a]
-> Read (Edit a)
forall a. Read a => ReadPrec [Edit a]
forall a. Read a => ReadPrec (Edit a)
forall a. Read a => Int -> ReadS (Edit a)
forall a. Read a => ReadS [Edit a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Edit a]
$creadListPrec :: forall a. Read a => ReadPrec [Edit a]
readPrec :: ReadPrec (Edit a)
$creadPrec :: forall a. Read a => ReadPrec (Edit a)
readList :: ReadS [Edit a]
$creadList :: forall a. Read a => ReadS [Edit a]
readsPrec :: Int -> ReadS (Edit a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Edit a)
Read, Int -> Edit a -> ShowS
[Edit a] -> ShowS
Edit a -> String
(Int -> Edit a -> ShowS)
-> (Edit a -> String) -> ([Edit a] -> ShowS) -> Show (Edit a)
forall a. Show a => Int -> Edit a -> ShowS
forall a. Show a => [Edit a] -> ShowS
forall a. Show a => Edit a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Edit a] -> ShowS
$cshowList :: forall a. Show a => [Edit a] -> ShowS
show :: Edit a -> String
$cshow :: forall a. Show a => Edit a -> String
showsPrec :: Int -> Edit a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Edit a -> ShowS
Show, Edit a -> Edit a -> Bool
(Edit a -> Edit a -> Bool)
-> (Edit a -> Edit a -> Bool) -> Eq (Edit a)
forall a. Eq a => Edit a -> Edit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edit a -> Edit a -> Bool
$c/= :: forall a. Eq a => Edit a -> Edit a -> Bool
== :: Edit a -> Edit a -> Bool
$c== :: forall a. Eq a => Edit a -> Edit a -> Bool
Eq, Eq (Edit a)
Eq (Edit a)
-> (Edit a -> Edit a -> Ordering)
-> (Edit a -> Edit a -> Bool)
-> (Edit a -> Edit a -> Bool)
-> (Edit a -> Edit a -> Bool)
-> (Edit a -> Edit a -> Bool)
-> (Edit a -> Edit a -> Edit a)
-> (Edit a -> Edit a -> Edit a)
-> Ord (Edit a)
Edit a -> Edit a -> Bool
Edit a -> Edit a -> Ordering
Edit a -> Edit a -> Edit a
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
forall a. Ord a => Eq (Edit a)
forall a. Ord a => Edit a -> Edit a -> Bool
forall a. Ord a => Edit a -> Edit a -> Ordering
forall a. Ord a => Edit a -> Edit a -> Edit a
min :: Edit a -> Edit a -> Edit a
$cmin :: forall a. Ord a => Edit a -> Edit a -> Edit a
max :: Edit a -> Edit a -> Edit a
$cmax :: forall a. Ord a => Edit a -> Edit a -> Edit a
>= :: Edit a -> Edit a -> Bool
$c>= :: forall a. Ord a => Edit a -> Edit a -> Bool
> :: Edit a -> Edit a -> Bool
$c> :: forall a. Ord a => Edit a -> Edit a -> Bool
<= :: Edit a -> Edit a -> Bool
$c<= :: forall a. Ord a => Edit a -> Edit a -> Bool
< :: Edit a -> Edit a -> Bool
$c< :: forall a. Ord a => Edit a -> Edit a -> Bool
compare :: Edit a -> Edit a -> Ordering
$ccompare :: forall a. Ord a => Edit a -> Edit a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Edit a)
Ord)

-- | Compute a list of edits that will turn the first list into the second list.
computeEdits :: Eq a => [a] -> [a] -> [Edit a]
computeEdits :: [a] -> [a] -> [Edit a]
computeEdits [a]
l [a]
r = DList (Edit a) -> [Edit a]
forall a. DList a -> [a]
DList.toList (DList (Edit a) -> [Edit a]) -> DList (Edit a) -> [Edit a]
forall a b. (a -> b) -> a -> b
$ Int
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
forall a.
Int
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
go Int
0 Maybe (Edit a)
forall a. Maybe a
Nothing ([a] -> [a] -> [Diff [a]]
forall a. Eq a => [a] -> [a] -> [Diff [a]]
Diff.getGroupedDiff [a]
l [a]
r) DList (Edit a)
forall a. Monoid a => a
mempty
  where
    {-
    Strategy: traverse the list of diffs, keeping the current index and (maybe) an in-progress 'Edit'.
    Whenever we see a 'Diff' that's only one side or the other, we can bundle that in to our in-progress
    'Edit'. We only have to stop if we see a 'Diff' that's on both sides (i.e. unchanged), then we
    dump the 'Edit' into the accumulator.
    We need the index, because 'Edit's need to say where they start.
    -}
    go :: Int -> Maybe (Edit a) -> [Diff.Diff [a]] -> DList.DList (Edit a) -> DList.DList (Edit a)
    -- No more diffs: append the current edit if there is one and return
    go :: Int
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
go Int
_ Maybe (Edit a)
e [] DList (Edit a)
acc = DList (Edit a)
acc DList (Edit a) -> DList (Edit a) -> DList (Edit a)
forall a. Semigroup a => a -> a -> a
<> [Edit a] -> DList (Edit a)
forall a. [a] -> DList a
DList.fromList (Maybe (Edit a) -> [Edit a]
forall a. Maybe a -> [a]
maybeToList Maybe (Edit a)
e)

    -- Items only on the left (i.e. deletions): increment the current index, and record the count of deletions,
    -- starting a new edit if necessary.
    go Int
ix Maybe (Edit a)
e (Diff.First [a]
ds : [Diff [a]]
rest) DList (Edit a)
acc =
      let
        deleteCount :: Int
deleteCount = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [a]
ds
        edit :: Edit a
edit = Edit a -> Maybe (Edit a) -> Edit a
forall a. a -> Maybe a -> a
fromMaybe (Int -> Int -> [a] -> Edit a
forall a. Int -> Int -> [a] -> Edit a
Edit Int
ix Int
0 []) Maybe (Edit a)
e
      in Int
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
forall a.
Int
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
deleteCount) (Edit a -> Maybe (Edit a)
forall a. a -> Maybe a
Just (Edit a
edit{$sel:editDeleteCount:Edit :: Int
editDeleteCount=Edit a -> Int
forall a. Edit a -> Int
editDeleteCount Edit a
edit Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
deleteCount})) [Diff [a]]
rest DList (Edit a)
acc
    -- Items only on the right (i.e. insertions): don't increment the current index, and record the insertions,
    -- starting a new edit if necessary.
    go Int
ix Maybe (Edit a)
e (Diff.Second [a]
as : [Diff [a]]
rest) DList (Edit a)
acc =
      let edit :: Edit a
edit = Edit a -> Maybe (Edit a) -> Edit a
forall a. a -> Maybe a -> a
fromMaybe (Int -> Int -> [a] -> Edit a
forall a. Int -> Int -> [a] -> Edit a
Edit Int
ix Int
0 []) Maybe (Edit a)
e
      in Int
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
forall a.
Int
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
go Int
ix (Edit a -> Maybe (Edit a)
forall a. a -> Maybe a
Just (Edit a
edit{$sel:editInsertions:Edit :: [a]
editInsertions=Edit a -> [a]
forall a. Edit a -> [a]
editInsertions Edit a
edit [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
as})) [Diff [a]]
rest DList (Edit a)
acc

    -- Items on both sides: increment the current index appropriately (since the items appear on the left),
    -- and append the current edit (if there is one) to our list of edits (since we can't continue it with a break).
    go Int
ix Maybe (Edit a)
e (Diff.Both [a]
bs [a]
_bs : [Diff [a]]
rest) DList (Edit a)
acc =
      let bothCount :: Int
bothCount = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [a]
bs
      in Int
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
forall a.
Int
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bothCount) Maybe (Edit a)
forall a. Maybe a
Nothing [Diff [a]]
rest (DList (Edit a)
acc DList (Edit a) -> DList (Edit a) -> DList (Edit a)
forall a. Semigroup a => a -> a -> a
<> [Edit a] -> DList (Edit a)
forall a. [a] -> DList a
DList.fromList (Maybe (Edit a) -> [Edit a]
forall a. Maybe a -> [a]
maybeToList Maybe (Edit a)
e))

-- | Convenience method for making a 'SemanticTokens' from a list of 'SemanticTokenAbsolute's. An error may be returned if
-- the tokens refer to types or modifiers which are not in the legend.
-- The resulting 'SemanticTokens' lacks a result ID, which must be set separately if you are using that.
makeSemanticTokens :: SemanticTokensLegend -> [SemanticTokenAbsolute] -> Either Text SemanticTokens
makeSemanticTokens :: SemanticTokensLegend
-> [SemanticTokenAbsolute] -> Either Text SemanticTokens
makeSemanticTokens SemanticTokensLegend
legend [SemanticTokenAbsolute]
sts = do
  [Int]
encoded <- SemanticTokensLegend
-> [SemanticTokenRelative] -> Either Text [Int]
encodeTokens SemanticTokensLegend
legend ([SemanticTokenRelative] -> Either Text [Int])
-> [SemanticTokenRelative] -> Either Text [Int]
forall a b. (a -> b) -> a -> b
$ [SemanticTokenAbsolute] -> [SemanticTokenRelative]
relativizeTokens [SemanticTokenAbsolute]
sts
  SemanticTokens -> Either Text SemanticTokens
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SemanticTokens -> Either Text SemanticTokens)
-> SemanticTokens -> Either Text SemanticTokens
forall a b. (a -> b) -> a -> b
$ Maybe Text -> List Int -> SemanticTokens
SemanticTokens Maybe Text
forall a. Maybe a
Nothing ([Int] -> List Int
forall a. [a] -> List a
List [Int]
encoded)

-- | Convenience function for making a 'SemanticTokensDelta' from a previous and current 'SemanticTokens'.
-- The resulting 'SemanticTokensDelta' lacks a result ID, which must be set separately if you are using that.
makeSemanticTokensDelta :: SemanticTokens -> SemanticTokens -> SemanticTokensDelta
makeSemanticTokensDelta :: SemanticTokens -> SemanticTokens -> SemanticTokensDelta
makeSemanticTokensDelta SemanticTokens{$sel:_xdata:SemanticTokens :: SemanticTokens -> List Int
_xdata=List [Int]
prevTokens} SemanticTokens{$sel:_xdata:SemanticTokens :: SemanticTokens -> List Int
_xdata=List [Int]
curTokens} =
  let edits :: [Edit Int]
edits = [Int] -> [Int] -> [Edit Int]
forall a. Eq a => [a] -> [a] -> [Edit a]
computeEdits [Int]
prevTokens [Int]
curTokens
      stEdits :: [SemanticTokensEdit]
stEdits = (Edit Int -> SemanticTokensEdit)
-> [Edit Int] -> [SemanticTokensEdit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Edit Int
s Int
ds [Int]
as) -> Int -> Int -> Maybe (List Int) -> SemanticTokensEdit
SemanticTokensEdit Int
s Int
ds (List Int -> Maybe (List Int)
forall a. a -> Maybe a
Just (List Int -> Maybe (List Int)) -> List Int -> Maybe (List Int)
forall a b. (a -> b) -> a -> b
$ [Int] -> List Int
forall a. [a] -> List a
List [Int]
as)) [Edit Int]
edits
  in Maybe Text -> List SemanticTokensEdit -> SemanticTokensDelta
SemanticTokensDelta Maybe Text
forall a. Maybe a
Nothing ([SemanticTokensEdit] -> List SemanticTokensEdit
forall a. [a] -> List a
List [SemanticTokensEdit]
stEdits)