{-# OPTIONS_GHC -fno-warn-missing-pattern-synonym-signatures #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE RecordWildCards            #-}
module Language.Rzk.VSCode.Tokens where

import           Data.Aeson
import           Data.String  (IsString)
import           Data.Text    (Text)
import           GHC.Generics (Generic)

-- | VS Code token.
data VSToken = VSToken
  { VSToken -> Int
line           :: !Int
  , VSToken -> Int
startCharacter :: !Int
  , VSToken -> Int
length         :: !Int
  , VSToken -> VSTokenType
tokenType      :: VSTokenType
  , VSToken -> [VSTokenModifier]
tokenModifiers :: [VSTokenModifier]
  } deriving (forall x. Rep VSToken x -> VSToken
forall x. VSToken -> Rep VSToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VSToken x -> VSToken
$cfrom :: forall x. VSToken -> Rep VSToken x
Generic, [VSToken] -> Encoding
[VSToken] -> Value
VSToken -> Encoding
VSToken -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VSToken] -> Encoding
$ctoEncodingList :: [VSToken] -> Encoding
toJSONList :: [VSToken] -> Value
$ctoJSONList :: [VSToken] -> Value
toEncoding :: VSToken -> Encoding
$ctoEncoding :: VSToken -> Encoding
toJSON :: VSToken -> Value
$ctoJSON :: VSToken -> Value
ToJSON)

-- | VS Code token types. See https://code.visualstudio.com/api/language-extensions/semantic-highlight-guide#standard-token-types-and-modifiers.
newtype VSTokenType = VSTokenType Text
  deriving newtype ([VSTokenType] -> Encoding
[VSTokenType] -> Value
VSTokenType -> Encoding
VSTokenType -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VSTokenType] -> Encoding
$ctoEncodingList :: [VSTokenType] -> Encoding
toJSONList :: [VSTokenType] -> Value
$ctoJSONList :: [VSTokenType] -> Value
toEncoding :: VSTokenType -> Encoding
$ctoEncoding :: VSTokenType -> Encoding
toJSON :: VSTokenType -> Value
$ctoJSON :: VSTokenType -> Value
ToJSON, String -> VSTokenType
forall a. (String -> a) -> IsString a
fromString :: String -> VSTokenType
$cfromString :: String -> VSTokenType
IsString)

-- | VS Code token modifiers. See https://code.visualstudio.com/api/language-extensions/semantic-highlight-guide#standard-token-types-and-modifiers.
newtype VSTokenModifier = VSTokenModifier Text
  deriving newtype ([VSTokenModifier] -> Encoding
[VSTokenModifier] -> Value
VSTokenModifier -> Encoding
VSTokenModifier -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VSTokenModifier] -> Encoding
$ctoEncodingList :: [VSTokenModifier] -> Encoding
toJSONList :: [VSTokenModifier] -> Value
$ctoJSONList :: [VSTokenModifier] -> Value
toEncoding :: VSTokenModifier -> Encoding
$ctoEncoding :: VSTokenModifier -> Encoding
toJSON :: VSTokenModifier -> Value
$ctoJSON :: VSTokenModifier -> Value
ToJSON, String -> VSTokenModifier
forall a. (String -> a) -> IsString a
fromString :: String -> VSTokenModifier
$cfromString :: String -> VSTokenModifier
IsString)

-- * Standard token types

-- | For identifiers that declare or reference a namespace, module, or package.
vs_namespace :: VSTokenType
vs_namespace :: VSTokenType
vs_namespace = Text -> VSTokenType
VSTokenType Text
"namespace"

-- | For identifiers that declare or reference a class type.
vs_class :: VSTokenType
vs_class :: VSTokenType
vs_class = Text -> VSTokenType
VSTokenType Text
"class"

-- | For identifiers that declare or reference an enumeration type.
vs_enum :: VSTokenType
vs_enum :: VSTokenType
vs_enum = Text -> VSTokenType
VSTokenType Text
"enum"

-- | For identifiers that declare or reference an interface type.
vs_interface :: VSTokenType
vs_interface :: VSTokenType
vs_interface = Text -> VSTokenType
VSTokenType Text
"interface"

-- | For identifiers that declare or reference a struct type.
vs_struct :: VSTokenType
vs_struct :: VSTokenType
vs_struct = Text -> VSTokenType
VSTokenType Text
"struct"

-- | For identifiers that declare or reference a type parameter.
vs_typeParameter :: VSTokenType
vs_typeParameter :: VSTokenType
vs_typeParameter = Text -> VSTokenType
VSTokenType Text
"typeParameter"

-- | For identifiers that declare or reference a type that is not covered above.
vs_type :: VSTokenType
vs_type :: VSTokenType
vs_type = Text -> VSTokenType
VSTokenType Text
"type"

-- | For identifiers that declare or reference a function or method parameters.
vs_parameter :: VSTokenType
vs_parameter :: VSTokenType
vs_parameter = Text -> VSTokenType
VSTokenType Text
"parameter"

-- | For identifiers that declare or reference a local or global variable.
vs_variable :: VSTokenType
vs_variable :: VSTokenType
vs_variable = Text -> VSTokenType
VSTokenType Text
"variable"

-- | For identifiers that declare or reference a member property, member field, or member variable.
vs_property :: VSTokenType
vs_property :: VSTokenType
vs_property = Text -> VSTokenType
VSTokenType Text
"property"

-- | For identifiers that declare or reference an enumeration property, constant, or member.
vs_enumMember :: VSTokenType
vs_enumMember :: VSTokenType
vs_enumMember = Text -> VSTokenType
VSTokenType Text
"enumMember"

-- | For identifiers that declare or reference decorators and annotations.
vs_decorator :: VSTokenType
vs_decorator :: VSTokenType
vs_decorator = Text -> VSTokenType
VSTokenType Text
"decorator"

-- | For identifiers that declare an event property.
vs_event :: VSTokenType
vs_event :: VSTokenType
vs_event = Text -> VSTokenType
VSTokenType Text
"event"

-- | For identifiers that declare a function.
vs_function :: VSTokenType
vs_function :: VSTokenType
vs_function = Text -> VSTokenType
VSTokenType Text
"function"

-- | For identifiers that declare a member function or method.
vs_method :: VSTokenType
vs_method :: VSTokenType
vs_method = Text -> VSTokenType
VSTokenType Text
"method"

-- | For identifiers that declare a macro.
vs_macro :: VSTokenType
vs_macro :: VSTokenType
vs_macro = Text -> VSTokenType
VSTokenType Text
"macro"

-- | For identifiers that declare a label.
vs_label :: VSTokenType
vs_label :: VSTokenType
vs_label = Text -> VSTokenType
VSTokenType Text
"label"

-- | For tokens that represent a comment.
vs_comment :: VSTokenType
vs_comment :: VSTokenType
vs_comment = Text -> VSTokenType
VSTokenType Text
"comment"

-- | For tokens that represent a string literal.
vs_string :: VSTokenType
vs_string :: VSTokenType
vs_string = Text -> VSTokenType
VSTokenType Text
"string"

-- | For tokens that represent a language keyword.
vs_keyword :: VSTokenType
vs_keyword :: VSTokenType
vs_keyword = Text -> VSTokenType
VSTokenType Text
"keyword"

-- | For tokens that represent a number literal.
vs_number :: VSTokenType
vs_number :: VSTokenType
vs_number = Text -> VSTokenType
VSTokenType Text
"number"

-- | For tokens that represent a regular expression literal.
vs_regexp :: VSTokenType
vs_regexp :: VSTokenType
vs_regexp = Text -> VSTokenType
VSTokenType Text
"regexp"

-- | For tokens that represent an operator.
vs_operator :: VSTokenType
vs_operator :: VSTokenType
vs_operator = Text -> VSTokenType
VSTokenType Text
"operator"

-- * Standard token modifiers

-- | For declarations of symbols.
vs_declaration :: VSTokenModifier
vs_declaration :: VSTokenModifier
vs_declaration = Text -> VSTokenModifier
VSTokenModifier Text
"declaration"

-- | For definitions of symbols, for example, in header files.
vs_definition :: VSTokenModifier
vs_definition :: VSTokenModifier
vs_definition = Text -> VSTokenModifier
VSTokenModifier Text
"definition"

-- | For readonly variables and member fields (constants).
vs_readonly :: VSTokenModifier
vs_readonly :: VSTokenModifier
vs_readonly = Text -> VSTokenModifier
VSTokenModifier Text
"readonly"

-- | For class members (static members).
vs_static :: VSTokenModifier
vs_static :: VSTokenModifier
vs_static = Text -> VSTokenModifier
VSTokenModifier Text
"static"

-- | For symbols that should no longer be used.
vs_deprecated :: VSTokenModifier
vs_deprecated :: VSTokenModifier
vs_deprecated = Text -> VSTokenModifier
VSTokenModifier Text
"deprecated"

-- | For types and member functions that are abstract.
vs_abstract :: VSTokenModifier
vs_abstract :: VSTokenModifier
vs_abstract = Text -> VSTokenModifier
VSTokenModifier Text
"abstract"

-- | For functions that are marked async.
vs_async :: VSTokenModifier
vs_async :: VSTokenModifier
vs_async = Text -> VSTokenModifier
VSTokenModifier Text
"async"

-- | For variable references where the variable is assigned to.
vs_modification :: VSTokenModifier
vs_modification :: VSTokenModifier
vs_modification = Text -> VSTokenModifier
VSTokenModifier Text
"modification"

-- | For occurrences of symbols in documentation.
vs_documentation :: VSTokenModifier
vs_documentation :: VSTokenModifier
vs_documentation = Text -> VSTokenModifier
VSTokenModifier Text
"documentation"

-- | For symbols that are part of the standard library.
vs_defaultLibrary :: VSTokenModifier
vs_defaultLibrary :: VSTokenModifier
vs_defaultLibrary = Text -> VSTokenModifier
VSTokenModifier Text
"defaultLibrary"