diff --git a/docs/features.md b/docs/features.md index 0a6a1fc345..037ae9669d 100644 --- a/docs/features.md +++ b/docs/features.md @@ -399,7 +399,7 @@ Rewrites record selectors to use overloaded dot syntax ![Explicit Wildcard Demo](../plugins/hls-overloaded-record-dot-plugin/example.gif) -### Missing features +## Missing features The following features are supported by the LSP specification but not implemented in HLS. Contributions welcome! diff --git a/plugins/hls-semantic-tokens-plugin/hls-semantic-tokens-plugin.cabal b/plugins/hls-semantic-tokens-plugin/hls-semantic-tokens-plugin.cabal index e0854733dc..463e4a4707 100644 --- a/plugins/hls-semantic-tokens-plugin/hls-semantic-tokens-plugin.cabal +++ b/plugins/hls-semantic-tokens-plugin/hls-semantic-tokens-plugin.cabal @@ -28,6 +28,7 @@ library Ide.Plugin.SemanticTokens.Mappings other-modules: Ide.Plugin.SemanticTokens.Query + Ide.Plugin.SemanticTokens.SemanticConfig Ide.Plugin.SemanticTokens.Utils Ide.Plugin.SemanticTokens.Internal @@ -52,12 +53,15 @@ library , array , deepseq , hls-graph == 2.5.0.0 + , template-haskell + , data-default default-language: Haskell2010 default-extensions: DataKinds test-suite tests type: exitcode-stdio-1.0 + ghc-options: -Wall default-language: Haskell2010 hs-source-dirs: test main-is: Main.hs @@ -83,3 +87,5 @@ test-suite tests , bytestring , ghcide == 2.5.0.0 , hls-plugin-api == 2.5.0.0 + , template-haskell + , data-default diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens.hs index 2386827a2a..41708d30c2 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Ide.Plugin.SemanticTokens (descriptor) where @@ -11,10 +12,11 @@ import Language.LSP.Protocol.Message descriptor :: Recorder (WithPriority SemanticLog) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = (defaultPluginDescriptor plId "Provides semantic tokens") - { Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentSemanticTokensFull Internal.semanticTokensFull, + { Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentSemanticTokensFull (Internal.semanticTokensFull recorder), Ide.Types.pluginRules = Internal.getSemanticTokensRule recorder <> Internal.persistentGetSemanticTokensRule, pluginConfigDescriptor = defaultConfigDescriptor { configInitialGenericConfig = (configInitialGenericConfig defaultConfigDescriptor) {plcGlobalOn = False} + , configCustomConfig = mkCustomConfig Internal.semanticConfigProperties } } diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs index 9e69a213c8..4c22af78db 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs @@ -1,82 +1,86 @@ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnicodeSyntax #-} -- | -- This module provides the core functionality of the plugin. -module Ide.Plugin.SemanticTokens.Internal (semanticTokensFull, getSemanticTokensRule, persistentGetSemanticTokensRule) where +module Ide.Plugin.SemanticTokens.Internal (semanticTokensFull, getSemanticTokensRule, persistentGetSemanticTokensRule, semanticConfigProperties) where -import Control.Lens ((^.)) -import Control.Monad.Except (ExceptT, liftEither, - withExceptT) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Trans (lift) -import Control.Monad.Trans.Except (runExceptT) -import qualified Data.Map as Map -import qualified Data.Text as T -import Development.IDE (Action, - GetDocMap (GetDocMap), - GetHieAst (GetHieAst), - HieAstResult (HAR, hieAst, hieModule, refMap), - IdeResult, IdeState, - Priority (..), Recorder, - Rules, WithPriority, - cmapWithPrio, define, - fromNormalizedFilePath, - hieKind, ideLogger, - logPriority, use_) -import Development.IDE.Core.PluginUtils (runActionE, - useWithStaleE) -import Development.IDE.Core.PositionMapping (idDelta) -import Development.IDE.Core.Rules (toIdeResult) -import Development.IDE.Core.RuleTypes (DocAndTyThingMap (..)) -import Development.IDE.Core.Shake (addPersistentRule, - getVirtualFile, - useWithStale_) -import Development.IDE.GHC.Compat hiding (Warning) -import Development.IDE.GHC.Compat.Util (mkFastString) -import Ide.Logger (logWith) -import Ide.Plugin.Error (PluginError (PluginInternalError), - getNormalizedFilePathE, - handleMaybe, - handleMaybeM) +import Control.Lens ((^.)) +import Control.Monad.Except (ExceptT, liftEither, + withExceptT) +import Control.Monad.Trans (lift) +import Control.Monad.Trans.Except (runExceptT) +import Data.Aeson (ToJSON (toJSON)) +import qualified Data.Map as Map +import Development.IDE (Action, + GetDocMap (GetDocMap), + GetHieAst (GetHieAst), + HieAstResult (HAR, hieAst, hieModule, refMap), + IdeResult, IdeState, + Priority (..), + Recorder, Rules, + WithPriority, + cmapWithPrio, define, + fromNormalizedFilePath, + hieKind, logPriority, + usePropertyAction, + use_) +import Development.IDE.Core.PluginUtils (runActionE, + useWithStaleE) +import Development.IDE.Core.PositionMapping (idDelta) +import Development.IDE.Core.Rules (toIdeResult) +import Development.IDE.Core.RuleTypes (DocAndTyThingMap (..)) +import Development.IDE.Core.Shake (addPersistentRule, + getVirtualFile, + useWithStale_) +import Development.IDE.GHC.Compat hiding (Warning) +import Development.IDE.GHC.Compat.Util (mkFastString) +import Ide.Logger (logWith) +import Ide.Plugin.Error (PluginError (PluginInternalError), + getNormalizedFilePathE, + handleMaybe, + handleMaybeM) import Ide.Plugin.SemanticTokens.Mappings import Ide.Plugin.SemanticTokens.Query +import Ide.Plugin.SemanticTokens.SemanticConfig (mkSemanticConfigFunctions) import Ide.Plugin.SemanticTokens.Types import Ide.Types -import qualified Language.LSP.Protocol.Lens as L -import Language.LSP.Protocol.Message (Method (Method_TextDocumentSemanticTokensFull)) -import Language.LSP.Protocol.Types (NormalizedFilePath, - SemanticTokens, - type (|?) (InL)) -import Prelude hiding (span) +import qualified Language.LSP.Protocol.Lens as L +import Language.LSP.Protocol.Message (Method (Method_TextDocumentSemanticTokensFull)) +import Language.LSP.Protocol.Types (NormalizedFilePath, + SemanticTokens, + type (|?) (InL)) +import Prelude hiding (span) -logActionWith :: (MonadIO m) => IdeState -> Priority -> String -> m () -logActionWith st prior = liftIO . logPriority (ideLogger st) prior . T.pack + +$mkSemanticConfigFunctions ----------------------- ---- the api ----------------------- -computeSemanticTokens :: IdeState -> NormalizedFilePath -> ExceptT PluginError Action SemanticTokens -computeSemanticTokens st nfp = do - logActionWith st Debug $ "Computing semantic tokens:" <> show nfp +computeSemanticTokens :: Recorder (WithPriority SemanticLog) -> PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError Action SemanticTokens +computeSemanticTokens recorder pid _ nfp = do + config <- lift $ useSemanticConfigAction pid + logWith recorder Debug (LogConfig config) (RangeHsSemanticTokenTypes {rangeSemanticMap}, mapping) <- useWithStaleE GetSemanticTokens nfp - withExceptT PluginInternalError $ liftEither $ rangeSemanticMapSemanticTokens mapping rangeSemanticMap + withExceptT PluginInternalError $ liftEither $ rangeSemanticMapSemanticTokens config mapping rangeSemanticMap -semanticTokensFull :: PluginMethodHandler IdeState 'Method_TextDocumentSemanticTokensFull -semanticTokensFull state _ param = do +semanticTokensFull :: Recorder (WithPriority SemanticLog) -> PluginMethodHandler IdeState 'Method_TextDocumentSemanticTokensFull +semanticTokensFull recorder state pid param = do nfp <- getNormalizedFilePathE (param ^. L.textDocument . L.uri) - items <- runActionE "SemanticTokens.semanticTokensFull" state $ computeSemanticTokens state nfp + items <- runActionE "SemanticTokens.semanticTokensFull" state $ computeSemanticTokens recorder pid state nfp return $ InL items -- | Defines the 'getSemanticTokensRule' function, compute semantic tokens for a Haskell source file. diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Mappings.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Mappings.hs index b369b0403c..fd724ed92f 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Mappings.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Mappings.hs @@ -32,33 +32,29 @@ import Language.LSP.VFS hiding (line) -- * 1. Mapping semantic token type to and from the LSP default token type. -- | map from haskell semantic token type to LSP default token type -toLspTokenType :: HsSemanticTokenType -> SemanticTokenTypes -toLspTokenType tk = case tk of - -- Function type variable - TFunction -> SemanticTokenTypes_Function - -- None function type variable - TVariable -> SemanticTokenTypes_Variable - TClass -> SemanticTokenTypes_Class - TClassMethod -> SemanticTokenTypes_Method - TTypeVariable -> SemanticTokenTypes_TypeParameter - -- normal data type is a tagged union type look like enum type - -- and a record is a product type like struct - -- but we don't distinguish them yet - TTypeCon -> SemanticTokenTypes_Enum - TDataCon -> SemanticTokenTypes_EnumMember - TRecField -> SemanticTokenTypes_Property - -- pattern syn is like a limited version of macro of constructing a term - TPatternSyn -> SemanticTokenTypes_Macro - -- saturated type - TTypeSyn -> SemanticTokenTypes_Type - -- not sure if this is correct choice - TTypeFamily -> SemanticTokenTypes_Interface - -lspTokenReverseMap :: Map.Map SemanticTokenTypes HsSemanticTokenType -lspTokenReverseMap = Map.fromList $ map (\x -> (toLspTokenType x, x)) $ enumFrom minBound - -fromLspTokenType :: SemanticTokenTypes -> Maybe HsSemanticTokenType -fromLspTokenType tk = Map.lookup tk lspTokenReverseMap +toLspTokenType :: SemanticTokensConfig -> HsSemanticTokenType -> SemanticTokenTypes +toLspTokenType conf tk = case tk of + TFunction -> stFunction conf + TVariable -> stVariable conf + TClassMethod -> stClassMethod conf + TTypeVariable -> stTypeVariable conf + TDataConstructor -> stDataConstructor conf + TClass -> stClass conf + TTypeConstructor -> stTypeConstructor conf + TTypeSynonym -> stTypeSynonym conf + TTypeFamily -> stTypeFamily conf + TRecordField -> stRecordField conf + TPatternSynonym -> stPatternSynonym conf + +lspTokenReverseMap :: SemanticTokensConfig -> Map.Map SemanticTokenTypes HsSemanticTokenType +lspTokenReverseMap config + | length xs /= Map.size mr = error "lspTokenReverseMap: token type mapping is not bijection" + | otherwise = mr + where xs = enumFrom minBound + mr = Map.fromList $ map (\x -> (toLspTokenType config x, x)) xs + +lspTokenTypeHsTokenType :: SemanticTokensConfig -> SemanticTokenTypes -> Maybe HsSemanticTokenType +lspTokenTypeHsTokenType cf tk = Map.lookup tk (lspTokenReverseMap cf) -- * 2. Mapping from GHC type and tyThing to semantic token type. @@ -67,19 +63,19 @@ tyThingSemantic :: TyThing -> Maybe HsSemanticTokenType tyThingSemantic ty = case ty of AnId vid | isTyVar vid -> Just TTypeVariable - | isRecordSelector vid -> Just TRecField + | isRecordSelector vid -> Just TRecordField | isClassOpId vid -> Just TClassMethod | isFunVar vid -> Just TFunction | otherwise -> Just TVariable AConLike con -> case con of - RealDataCon _ -> Just TDataCon - PatSynCon _ -> Just TPatternSyn + RealDataCon _ -> Just TDataConstructor + PatSynCon _ -> Just TPatternSynonym ATyCon tyCon - | isTypeSynonymTyCon tyCon -> Just TTypeSyn + | isTypeSynonymTyCon tyCon -> Just TTypeSynonym | isTypeFamilyTyCon tyCon -> Just TTypeFamily | isClassTyCon tyCon -> Just TClass - -- fall back to TTypeCon the result - | otherwise -> Just TTypeCon + -- fall back to TTypeConstructor the result + | otherwise -> Just TTypeConstructor ACoAxiom _ -> Nothing where isFunVar :: Var -> Bool @@ -143,36 +139,53 @@ infoTokenType x = case x of PatternBind {} -> Just TVariable ClassTyDecl _ -> Just TClassMethod TyVarBind _ _ -> Just TTypeVariable - RecField _ _ -> Just TRecField + RecField _ _ -> Just TRecordField -- data constructor, type constructor, type synonym, type family Decl ClassDec _ -> Just TClass - Decl DataDec _ -> Just TTypeCon - Decl ConDec _ -> Just TDataCon - Decl SynDec _ -> Just TTypeSyn + Decl DataDec _ -> Just TTypeConstructor + Decl ConDec _ -> Just TDataConstructor + Decl SynDec _ -> Just TTypeSynonym Decl FamDec _ -> Just TTypeFamily -- instance dec is class method Decl InstDec _ -> Just TClassMethod - Decl PatSynDec _ -> Just TPatternSyn + Decl PatSynDec _ -> Just TPatternSynonym EvidenceVarUse -> Nothing EvidenceVarBind {} -> Nothing -- * 4. Mapping from LSP tokens to SemanticTokenOriginal. --- | line, startChar, len, tokenType, modifiers -type ActualToken = (UInt, UInt, UInt, HsSemanticTokenType, UInt) - -- | recoverSemanticTokens -- for debug and test. -- this function is used to recover the original tokens(with token in haskell token type zoon) -- from the lsp semantic tokens(with token in lsp token type zoon) -recoverSemanticTokens :: VirtualFile -> SemanticTokens -> Either Text [SemanticTokenOriginal] -recoverSemanticTokens vsf (SemanticTokens _ xs) = do +-- the `SemanticTokensConfig` used should be a map with bijection property +recoverSemanticTokens :: SemanticTokensConfig -> VirtualFile -> SemanticTokens -> Either Text [SemanticTokenOriginal HsSemanticTokenType] +recoverSemanticTokens config v s = do + tks <- recoverLspSemanticTokens v s + return $ map (lspTokenHsToken config) tks + +-- | lspTokenHsToken +-- for debug and test. +-- use the `SemanticTokensConfig` to convert lsp token type to haskell token type +-- the `SemanticTokensConfig` used should be a map with bijection property +lspTokenHsToken :: SemanticTokensConfig -> SemanticTokenOriginal SemanticTokenTypes -> SemanticTokenOriginal HsSemanticTokenType +lspTokenHsToken config (SemanticTokenOriginal tokenType location name) = + case lspTokenTypeHsTokenType config tokenType of + Just t -> SemanticTokenOriginal t location name + Nothing -> error "recoverSemanticTokens: unknown lsp token type" + +-- | recoverLspSemanticTokens +-- for debug and test. +-- this function is used to recover the original tokens(with token in standard lsp token type zoon) +-- from the lsp semantic tokens(with token in lsp token type zoon) +recoverLspSemanticTokens :: VirtualFile -> SemanticTokens -> Either Text [SemanticTokenOriginal SemanticTokenTypes] +recoverLspSemanticTokens vsf (SemanticTokens _ xs) = do tokens <- dataActualToken xs return $ mapMaybe (tokenOrigin sourceCode) tokens where sourceCode = unpack $ virtualFileText vsf - tokenOrigin :: [Char] -> ActualToken -> Maybe SemanticTokenOriginal - tokenOrigin sourceCode' (line, startChar, len, tokenType, _) = do + tokenOrigin :: [Char] -> SemanticTokenAbsolute -> Maybe (SemanticTokenOriginal SemanticTokenTypes) + tokenOrigin sourceCode' (SemanticTokenAbsolute line startChar len tokenType _tokenModifiers) = do -- convert back to count from 1 let range = mkRange line startChar len CodePointRange (CodePointPosition x y) (CodePointPosition _ y1) <- rangeToCodePointRange vsf range @@ -183,20 +196,15 @@ recoverSemanticTokens vsf (SemanticTokens _ xs) = do let name = maybe "no source" (take (fromIntegral len') . drop (fromIntegral startChar')) tLine return $ SemanticTokenOriginal tokenType (Loc (line' + 1) (startChar' + 1) len') name - dataActualToken :: [UInt] -> Either Text [ActualToken] + dataActualToken :: [UInt] -> Either Text [SemanticTokenAbsolute] dataActualToken dt = - maybe decodeError (Right . fmap semanticTokenAbsoluteActualToken . absolutizeTokens) $ + maybe decodeError (Right . absolutizeTokens) $ mapM fromTuple (chunksOf 5 $ map fromIntegral dt) where decodeError = Left "recoverSemanticTokenRelative: wrong token data" fromTuple [a, b, c, d, _] = SemanticTokenRelative a b c <$> fromInt (fromIntegral d) <*> return [] fromTuple _ = Nothing - semanticTokenAbsoluteActualToken :: SemanticTokenAbsolute -> ActualToken - semanticTokenAbsoluteActualToken (SemanticTokenAbsolute line startChar len tokenType _tokenModifiers) = - case fromLspTokenType tokenType of - Just t -> (line, startChar, len, t, 0) - Nothing -> error "semanticTokenAbsoluteActualToken: unknown token type" -- legends :: SemanticTokensLegend fromInt :: Int -> Maybe SemanticTokenTypes diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Query.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Query.hs index d686d3dd00..174048049f 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Query.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Query.hs @@ -22,7 +22,8 @@ import Development.IDE.GHC.Error (realSrcSpanToCodePointRan import Ide.Plugin.SemanticTokens.Mappings import Ide.Plugin.SemanticTokens.Types (HieFunMaskKind, HsSemanticTokenType, - NameSemanticMap) + NameSemanticMap, + SemanticTokensConfig) import Language.LSP.Protocol.Types import Language.LSP.VFS (VirtualFile, codePointRangeToRange) @@ -93,14 +94,14 @@ hieAstSpanNames vf ast = ------------------------------------------------- extractSemanticTokensFromNames :: NameSemanticMap -> M.Map Range NameSet -> M.Map Range HsSemanticTokenType -extractSemanticTokensFromNames nsm rnMap = Map.mapMaybe (foldMap (lookupNameEnv nsm) . nameSetElemsStable) rnMap +extractSemanticTokensFromNames nsm = Map.mapMaybe (foldMap (lookupNameEnv nsm) . nameSetElemsStable) -rangeSemanticMapSemanticTokens :: PositionMapping -> M.Map Range HsSemanticTokenType -> Either Text SemanticTokens -rangeSemanticMapSemanticTokens mapping = +rangeSemanticMapSemanticTokens :: SemanticTokensConfig -> PositionMapping -> M.Map Range HsSemanticTokenType -> Either Text SemanticTokens +rangeSemanticMapSemanticTokens stc mapping = makeSemanticTokens defaultSemanticTokensLegend . mapMaybe (\(range, ty) -> flip toAbsSemanticToken ty <$> range) . Map.toAscList - . M.mapKeys (\r -> toCurrentRange mapping r) + . M.mapKeys (toCurrentRange mapping) where toAbsSemanticToken :: Range -> HsSemanticTokenType -> SemanticTokenAbsolute toAbsSemanticToken (Range (Position startLine startColumn) (Position _endLine endColumn)) tokenType = @@ -109,5 +110,5 @@ rangeSemanticMapSemanticTokens mapping = (fromIntegral startLine) (fromIntegral startColumn) (fromIntegral len) - (toLspTokenType tokenType) + (toLspTokenType stc tokenType) [] diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs new file mode 100644 index 0000000000..7afcc879da --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Ide.Plugin.SemanticTokens.SemanticConfig where + +import Data.Char (toLower) +import Data.Default (def) +import qualified Data.Set as S +import qualified Data.Text as T +import Development.IDE (usePropertyAction) +import Ide.Plugin.Properties (defineEnumProperty, + emptyProperties) +import Ide.Plugin.SemanticTokens.Types +import Language.Haskell.TH +import Language.LSP.Protocol.Types (LspEnum (..), + SemanticTokenTypes) + + + +docName :: HsSemanticTokenType -> T.Text +docName tt = case tt of + TVariable -> "variables" + TFunction -> "functions" + TDataConstructor -> "data constructors" + TTypeVariable -> "type variables" + TClassMethod -> "typeclass methods" + TPatternSynonym -> "pattern synonyms" + TTypeConstructor -> "type constructors" + TClass -> "typeclasses" + TTypeSynonym -> "type synonyms" + TTypeFamily -> "type families" + TRecordField -> "record fields" + +toConfigName :: String -> String +toConfigName = ("st" <>) + +type LspTokenTypeDescriptions = [(SemanticTokenTypes, T.Text)] + +lspTokenTypeDescriptions :: LspTokenTypeDescriptions +lspTokenTypeDescriptions = + map + ( \x -> + (x, "LSP Semantic Token Type: " <> toEnumBaseType x) + ) + $ S.toList knownValues + +allHsTokenTypes :: [HsSemanticTokenType] +allHsTokenTypes = enumFrom minBound + +lowerFirst :: String -> String +lowerFirst [] = [] +lowerFirst (x:xs) = toLower x : xs + +allHsTokenNameStrings :: [String] +allHsTokenNameStrings = map (drop 1 . show) allHsTokenTypes + +defineSemanticProperty (lb, tokenType, st) = + defineEnumProperty + lb + tokenType + lspTokenTypeDescriptions + st + +semanticDef :: SemanticTokensConfig +semanticDef = def + +-- | it produces the following functions: +-- semanticConfigProperties :: Properties '[ +-- 'PropertyKey "Variable" ('TEnum SemanticTokenTypes), +-- ... +-- ] +-- useSemanticConfigAction :: PluginId -> Action SemanticTokensConfig +mkSemanticConfigFunctions :: Q [Dec] +mkSemanticConfigFunctions = do + let pid = mkName "pid" + let semanticConfigPropertiesName = mkName "semanticConfigProperties" + let useSemanticConfigActionName = mkName "useSemanticConfigAction" + let allLabels = map (LabelE . (<> "Token"). lowerFirst) allHsTokenNameStrings + allFieldsNames = map (mkName . toConfigName) allHsTokenNameStrings + allVariableNames = map (mkName . ("_variable_" <>) . toConfigName) allHsTokenNameStrings + -- <- useSemanticConfigAction label pid config + mkGetProperty (variable, label) = + BindS + (VarP variable) + (AppE (VarE 'usePropertyAction) label `AppE` VarE pid `AppE` VarE semanticConfigPropertiesName) + getProperties = zipWith (curry mkGetProperty) allVariableNames allLabels + recordUpdate = + RecUpdE (VarE 'semanticDef) $ + zipWith (\fieldName variableName -> (fieldName, VarE variableName)) allFieldsNames allVariableNames + -- get and then update record + bb = DoE Nothing $ getProperties ++ [NoBindS $ AppE (VarE 'return) recordUpdate] + let useSemanticConfigAction = FunD useSemanticConfigActionName [Clause [VarP pid] (NormalB bb) []] + + -- SemanticConfigProperties + nameAndDescList <- + mapM + ( \(lb, x) -> do + desc <- [|"LSP semantic token type to use for " <> docName x|] + lspToken <- [|toLspTokenType def x|] + return $ TupE [Just lb, Just desc, Just lspToken] + ) + $ zip allLabels allHsTokenTypes + let body = foldr (AppE . AppE (VarE 'defineSemanticProperty)) (VarE 'emptyProperties) nameAndDescList + let semanticConfigProperties = FunD semanticConfigPropertiesName [Clause [] (NormalB body) []] + return [semanticConfigProperties, useSemanticConfigAction] diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs index a6fb63c0c0..5be028ace8 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs @@ -1,14 +1,21 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TypeFamilies #-} module Ide.Plugin.SemanticTokens.Types where import Control.DeepSeq (NFData (rnf), rwhnf) import qualified Data.Array as A +import Data.Default (Default (def)) import Data.Generics (Typeable) import qualified Data.Map as M import Development.IDE (Pretty (pretty), RuleResult) @@ -17,6 +24,9 @@ import Development.IDE.GHC.Compat hiding (loc) import Development.IDE.Graph.Classes (Hashable) import GHC.Generics (Generic) import Language.LSP.Protocol.Types +-- import template haskell +import Language.Haskell.TH.Syntax (Lift) + -- !!!! order of declarations matters deriving enum and ord -- since token may come from different source and we want to keep the most specific one @@ -24,30 +34,68 @@ import Language.LSP.Protocol.Types data HsSemanticTokenType = TVariable -- none function variable | TFunction -- function - | TDataCon -- Data constructor + | TDataConstructor -- Data constructor | TTypeVariable -- Type variable | TClassMethod -- Class method - | TPatternSyn -- Pattern synonym - | TTypeCon -- Type (Type constructor) + | TPatternSynonym -- Pattern synonym + | TTypeConstructor -- Type (Type constructor) | TClass -- Type class - | TTypeSyn -- Type synonym + | TTypeSynonym -- Type synonym | TTypeFamily -- type family - | TRecField -- from match bind - deriving (Eq, Ord, Show, Enum, Bounded) + | TRecordField -- from match bind + deriving (Eq, Ord, Show, Enum, Bounded, Generic, Lift) + + + +-- type SemanticTokensConfig = SemanticTokensConfig_ Identity +instance Default SemanticTokensConfig where + def = STC + { stFunction = SemanticTokenTypes_Function + , stVariable = SemanticTokenTypes_Variable + , stDataConstructor = SemanticTokenTypes_EnumMember + , stTypeVariable = SemanticTokenTypes_TypeParameter + , stClassMethod = SemanticTokenTypes_Method + -- pattern syn is like a limited version of macro of constructing a term + , stPatternSynonym = SemanticTokenTypes_Macro + -- normal data type is a tagged union type look like enum type + -- and a record is a product type like struct + -- but we don't distinguish them yet + , stTypeConstructor = SemanticTokenTypes_Enum + , stClass = SemanticTokenTypes_Class + , stTypeSynonym = SemanticTokenTypes_Type + , stTypeFamily = SemanticTokenTypes_Interface + , stRecordField = SemanticTokenTypes_Property + } +-- | SemanticTokensConfig_ is a configuration for the semantic tokens plugin. +-- it contains map between the hs semantic token type and default token type. +data SemanticTokensConfig = STC + { stFunction :: !SemanticTokenTypes + , stVariable :: !SemanticTokenTypes + , stDataConstructor :: !SemanticTokenTypes + , stTypeVariable :: !SemanticTokenTypes + , stClassMethod :: !SemanticTokenTypes + , stPatternSynonym :: !SemanticTokenTypes + , stTypeConstructor :: !SemanticTokenTypes + , stClass :: !SemanticTokenTypes + , stTypeSynonym :: !SemanticTokenTypes + , stTypeFamily :: !SemanticTokenTypes + , stRecordField :: !SemanticTokenTypes + } deriving (Generic, Show) + instance Semigroup HsSemanticTokenType where -- one in higher enum is more specific a <> b = max a b -data SemanticTokenOriginal = SemanticTokenOriginal - { _tokenType :: HsSemanticTokenType, +data SemanticTokenOriginal tokenType = SemanticTokenOriginal + { _tokenType :: tokenType, _loc :: Loc, _name :: String } deriving (Eq, Ord) -- -instance Show SemanticTokenOriginal where +instance (Show tokenType) => Show (SemanticTokenOriginal tokenType) where show (SemanticTokenOriginal tk loc name) = show loc <> " " <> show tk <> " " <> show name data Loc = Loc @@ -87,6 +135,8 @@ data HieFunMaskKind kind where data SemanticLog = LogShake Shake.Log | LogNoAST FilePath + | LogConfig SemanticTokensConfig + | LogMsg String | LogNoVF deriving (Show) @@ -95,3 +145,6 @@ instance Pretty SemanticLog where LogShake shakeLog -> pretty shakeLog LogNoAST path -> "no HieAst exist for file" <> pretty path LogNoVF -> "no VirtualSourceFile exist for file" + LogConfig config -> "SemanticTokensConfig_: " <> pretty (show config) + LogMsg msg -> "SemanticLog Debug Message: " <> pretty msg + diff --git a/plugins/hls-semantic-tokens-plugin/test/Main.hs b/plugins/hls-semantic-tokens-plugin/test/Main.hs index 2d6224e7c1..ff02764658 100644 --- a/plugins/hls-semantic-tokens-plugin/test/Main.hs +++ b/plugins/hls-semantic-tokens-plugin/test/Main.hs @@ -5,60 +5,47 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -import Control.Arrow (Arrow ((***)), (&&&), - (+++)) -import Control.Lens hiding (use, (<.>)) -import Control.Monad (forM) +import Control.Lens ((^?)) import Control.Monad.IO.Class (liftIO) -import Data.Bifunctor -import qualified Data.ByteString as BS -import Data.Data +import Data.Aeson (KeyValue (..), Value (..), + object) import Data.Default import Data.Functor (void) -import qualified Data.List as List import Data.Map as Map hiding (map) -import Data.Maybe (fromJust) -import qualified Data.Maybe -import qualified Data.Set as Set import Data.String (fromString) import Data.Text hiding (length, map, unlines) +import qualified Data.Text as Text import qualified Data.Text.Utf16.Rope as Rope -import Development.IDE (getFileContents, runAction, - toNormalizedUri) -import Development.IDE.Core.Rules (Log) -import Development.IDE.Core.Shake (getVirtualFile) import Development.IDE.Plugin.Test (WaitForIdeRuleResult (..)) import Development.IDE.Test (waitForBuildQueue) -import Ide.Plugin.Error (getNormalizedFilePathE) import Ide.Plugin.SemanticTokens import Ide.Plugin.SemanticTokens.Mappings import Ide.Plugin.SemanticTokens.Types import Ide.Types -import qualified Language.LSP.Protocol.Lens as L -import Language.LSP.Protocol.Types (SemanticTokens (..), - SemanticTokensParams (..), - _L, type (|?) (..)) -import qualified Language.LSP.Server as Lsp -import Language.LSP.Test (Session (..), openDoc) +import Language.LSP.Protocol.Types (SemanticTokenTypes (..), + _L) +import Language.LSP.Test (Session (..), + SessionConfig (ignoreConfigurationRequests), + openDoc) import qualified Language.LSP.Test as Test import Language.LSP.VFS (VirtualFile (..)) -import System.Environment.Blank import System.FilePath +import qualified Test.Hls as Test import Test.Hls (PluginTestDescriptor, - Session (..), TestName, - TestTree, + TestName, TestTree, TextDocumentIdentifier, defaultTestRunner, - documentContents, + documentContents, fullCaps, goldenGitDiff, mkPluginTestDescriptor, - mkPluginTestDescriptor', + pluginTestRecorder, runSessionWithServerInTmpDir, + runSessionWithServerInTmpDir', testCase, testGroup, waitForAction, (@?=)) import qualified Test.Hls.FileSystem as FS -import Test.Hls.Util (withCanonicalTempDir) +import Test.Hls.FileSystem (file, text) testDataDir :: FilePath testDataDir = "test" "testdata" @@ -81,20 +68,16 @@ semanticTokensPlugin = Test.Hls.mkPluginTestDescriptor enabledSemanticDescriptor } } -mkSemanticTokensParams :: TextDocumentIdentifier -> SemanticTokensParams -mkSemanticTokensParams = SemanticTokensParams Nothing Nothing - goldenWithHaskellAndCapsOutPut config plugin title tree path desc act = goldenGitDiff title (FS.vftOriginalRoot tree path <.> desc) $ runSessionWithServerInTmpDir config plugin tree $ fromString <$> do doc <- openDoc (path <.> "hs") "haskell" void waitForBuildQueue - r <- act doc - return r + act doc -goldenWithSemanticTokens :: TestName -> FilePath -> TestTree -goldenWithSemanticTokens title path = +goldenWithSemanticTokensWithDefaultConfig :: TestName -> FilePath -> TestTree +goldenWithSemanticTokensWithDefaultConfig title path = goldenWithHaskellAndCapsOutPut def semanticTokensPlugin @@ -102,43 +85,78 @@ goldenWithSemanticTokens title path = (mkFs $ FS.directProject (path <.> "hs")) path "expected" - docSemanticTokensString + (docSemanticTokensString def) + +docSemanticTokensString :: SemanticTokensConfig-> TextDocumentIdentifier -> Session String +docSemanticTokensString cf doc = do + xs <- map (lspTokenHsToken cf) <$> docLspSemanticTokensString doc + return $ unlines . map show $ xs -docSemanticTokensString :: TextDocumentIdentifier -> Session String -docSemanticTokensString doc = do +docLspSemanticTokensString :: TextDocumentIdentifier -> Session [SemanticTokenOriginal Language.LSP.Protocol.Types.SemanticTokenTypes] +docLspSemanticTokensString doc = do res <- Test.getSemanticTokens doc textContent <- documentContents doc let vfs = VirtualFile 0 0 (Rope.fromText textContent) - let expect = [] - case res ^? _L of + case res ^? Language.LSP.Protocol.Types._L of Just tokens -> do - either (error . show) (return . unlines . map show) $ recoverSemanticTokens vfs tokens + either (error . show) pure $ recoverLspSemanticTokens vfs tokens _noTokens -> error "No tokens found" -semanticTokensImportedTests :: TestTree -semanticTokensImportedTests = - testGroup - "imported test" - [ goldenWithSemanticTokens "type class" "TClass" - ] - semanticTokensClassTests :: TestTree semanticTokensClassTests = testGroup "type class" - [ goldenWithSemanticTokens "golden type class" "TClass", - goldenWithSemanticTokens "imported class method InstanceClassMethodBind" "TInstanceClassMethodBind", - goldenWithSemanticTokens "imported class method TInstanceClassMethodUse" "TInstanceClassMethodUse", - goldenWithSemanticTokens "imported deriving" "TClassImportedDeriving" + [ goldenWithSemanticTokensWithDefaultConfig "golden type class" "TClass", + goldenWithSemanticTokensWithDefaultConfig "imported class method InstanceClassMethodBind" "TInstanceClassMethodBind", + goldenWithSemanticTokensWithDefaultConfig "imported class method TInstanceClassMethodUse" "TInstanceClassMethodUse", + goldenWithSemanticTokensWithDefaultConfig "imported deriving" "TClassImportedDeriving" ] semanticTokensValuePatternTests :: TestTree semanticTokensValuePatternTests = testGroup "value and patterns " - [ goldenWithSemanticTokens "value bind" "TValBind", - goldenWithSemanticTokens "pattern match" "TPatternMatch", - goldenWithSemanticTokens "pattern bind" "TPatternbind" + [ goldenWithSemanticTokensWithDefaultConfig "value bind" "TValBind", + goldenWithSemanticTokensWithDefaultConfig "pattern match" "TPatternMatch", + goldenWithSemanticTokensWithDefaultConfig "pattern bind" "TPatternbind" + ] + +mkSemanticConfig :: Value -> Config +mkSemanticConfig setting = def{plugins = Map.insert "SemanticTokens" conf (plugins def)} + where + conf = def{plcConfig = (\(Object obj) -> obj) setting } + +modifySemantic :: Value -> Session () +modifySemantic setting = Test.setHlsConfig $ mkSemanticConfig setting + + +directFile :: FilePath -> Text -> [FS.FileTree] +directFile fp content = + [ FS.directCradle [Text.pack fp] + , file fp (text content) + ] + +semanticTokensConfigTest :: TestTree +semanticTokensConfigTest = testGroup "semantic token config test" [ + testCase "function to variable" $ do + let content = Text.unlines ["module Hello where", "go _ = 1"] + let fs = mkFs $ directFile "Hello.hs" content + let funcVar = object ["functionToken" .= var] + var :: String + var = "variable" + do + recorder <- pluginTestRecorder + Test.Hls.runSessionWithServerInTmpDir' (semanticTokensPlugin recorder) + (mkSemanticConfig funcVar) + def {ignoreConfigurationRequests = False} + fullCaps + fs $ do + -- modifySemantic funcVar + void waitForBuildQueue + doc <- openDoc "Hello.hs" "haskell" + void waitForBuildQueue + result1 <- docLspSemanticTokensString doc + liftIO $ unlines (map show result1) @?= "2:1-3 SemanticTokenTypes_Variable \"go\"\n" ] semanticTokensTests :: TestTree @@ -146,60 +164,59 @@ semanticTokensTests = testGroup "other semantic Token test" [ testCase "module import test" $ do - let filePath1 = "./test/testdata/TModuleA.hs" - let filePath2 = "./test/testdata/TModuleB.hs" - let file1 = "TModuleA.hs" let file2 = "TModuleB.hs" let expect = [ SemanticTokenOriginal TVariable (Loc 5 1 2) "go", - SemanticTokenOriginal TDataCon (Loc 5 6 4) "Game" + SemanticTokenOriginal TDataConstructor (Loc 5 6 4) "Game" ] Test.Hls.runSessionWithServerInTmpDir def semanticTokensPlugin (mkFs $ FS.directProjectMulti [file1, file2]) $ do doc1 <- openDoc file1 "haskell" doc2 <- openDoc file2 "haskell" - check1 <- waitForAction "TypeCheck" doc1 + _check1 <- waitForAction "TypeCheck" doc1 check2 <- waitForAction "TypeCheck" doc2 case check2 of - Right (WaitForIdeRuleResult x) -> return () - Left y -> error "TypeCheck2 failed" + Right (WaitForIdeRuleResult _) -> return () + Left _ -> error "TypeCheck2 failed" - res2 <- Test.getSemanticTokens doc2 textContent2 <- documentContents doc2 let vfs = VirtualFile 0 0 (Rope.fromText textContent2) - case res2 ^? _L of + res2 <- Test.getSemanticTokens doc2 + case res2 ^? Language.LSP.Protocol.Types._L of Just tokens -> do either (error . show) (\xs -> liftIO $ xs @?= expect) - $ recoverSemanticTokens vfs tokens + $ recoverSemanticTokens def vfs tokens return () _ -> error "No tokens found" liftIO $ 1 @?= 1, - goldenWithSemanticTokens "mixed constancy test result generated from one ghc version" "T1", - goldenWithSemanticTokens "pattern bind" "TPatternSyn", - goldenWithSemanticTokens "type family" "TTypefamily", - goldenWithSemanticTokens "TUnicodeSyntax" "TUnicodeSyntax" + goldenWithSemanticTokensWithDefaultConfig "mixed constancy test result generated from one ghc version" "T1", + goldenWithSemanticTokensWithDefaultConfig "pattern bind" "TPatternSynonym", + goldenWithSemanticTokensWithDefaultConfig "type family" "TTypefamily", + goldenWithSemanticTokensWithDefaultConfig "TUnicodeSyntax" "TUnicodeSyntax" ] +semanticTokensDataTypeTests :: TestTree semanticTokensDataTypeTests = testGroup "get semantic Tokens" - [ goldenWithSemanticTokens "simple datatype" "TDataType", - goldenWithSemanticTokens "record" "TRecord", - goldenWithSemanticTokens "record" "TRecordDuplicateRecordFields", - goldenWithSemanticTokens "datatype import" "TDatatypeImported", - goldenWithSemanticTokens "datatype family" "TDataFamily", - goldenWithSemanticTokens "GADT" "TGADT" + [ goldenWithSemanticTokensWithDefaultConfig "simple datatype" "TDataType", + goldenWithSemanticTokensWithDefaultConfig "record" "TRecord", + goldenWithSemanticTokensWithDefaultConfig "record With DuplicateRecordFields" "TRecordDuplicateRecordFields", + goldenWithSemanticTokensWithDefaultConfig "datatype import" "TDatatypeImported", + goldenWithSemanticTokensWithDefaultConfig "datatype family" "TDataFamily", + goldenWithSemanticTokensWithDefaultConfig "GADT" "TGADT" ] +semanticTokensFunctionTests :: TestTree semanticTokensFunctionTests = testGroup "get semantic of functions" - [ goldenWithSemanticTokens "functions" "TFunction", - goldenWithSemanticTokens "local functions" "TFunctionLocal", - goldenWithSemanticTokens "function in let binding" "TFunctionLet", - goldenWithSemanticTokens "negative case non-function with constraint" "TNoneFunctionWithConstraint" + [ goldenWithSemanticTokensWithDefaultConfig "functions" "TFunction", + goldenWithSemanticTokensWithDefaultConfig "local functions" "TFunctionLocal", + goldenWithSemanticTokensWithDefaultConfig "function in let binding" "TFunctionLet", + goldenWithSemanticTokensWithDefaultConfig "negative case non-function with constraint" "TNoneFunctionWithConstraint" ] main :: IO () @@ -211,5 +228,6 @@ main = semanticTokensClassTests, semanticTokensDataTypeTests, semanticTokensValuePatternTests, - semanticTokensFunctionTests + semanticTokensFunctionTests, + semanticTokensConfigTest ] diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/T1.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/T1.expected index 8e00ed86de..062d4749d3 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/T1.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/T1.expected @@ -1,32 +1,32 @@ -9:6-9 TTypeCon "Foo" -9:12-15 TDataCon "Foo" -9:18-21 TRecField "foo" -9:25-28 TTypeCon "Int" +9:6-9 TTypeConstructor "Foo" +9:12-15 TDataConstructor "Foo" +9:18-21 TRecordField "foo" +9:25-28 TTypeConstructor "Int" 11:7-10 TClass "Boo" 11:11-12 TTypeVariable "a" 12:3-6 TClassMethod "boo" 12:10-11 TTypeVariable "a" 12:15-16 TTypeVariable "a" 14:10-13 TClass "Boo" -14:14-17 TTypeCon "Int" +14:14-17 TTypeConstructor "Int" 15:5-8 TClassMethod "boo" 15:9-10 TVariable "x" 15:13-14 TVariable "x" 15:15-16 TClassMethod "+" -17:6-8 TTypeCon "Dd" -17:11-13 TDataCon "Dd" -17:14-17 TTypeCon "Int" -19:9-12 TPatternSyn "One" -19:15-18 TDataCon "Foo" +17:6-8 TTypeConstructor "Dd" +17:11-13 TDataConstructor "Dd" +17:14-17 TTypeConstructor "Int" +19:9-12 TPatternSynonym "One" +19:15-18 TDataConstructor "Foo" 21:1-4 TVariable "ggg" -21:7-10 TPatternSyn "One" -23:6-9 TTypeCon "Doo" -23:12-15 TDataCon "Doo" -23:16-27 TTypeCon "Prelude.Int" -24:6-10 TTypeSyn "Bar1" -24:13-16 TTypeCon "Int" -25:6-10 TTypeSyn "Bar2" -25:13-16 TTypeCon "Doo" +21:7-10 TPatternSynonym "One" +23:6-9 TTypeConstructor "Doo" +23:12-15 TDataConstructor "Doo" +23:16-27 TTypeConstructor "Prelude.Int" +24:6-10 TTypeSynonym "Bar1" +24:13-16 TTypeConstructor "Int" +25:6-10 TTypeSynonym "Bar2" +25:13-16 TTypeConstructor "Doo" 27:1-3 TFunction "bb" 27:8-11 TClass "Boo" 27:12-13 TTypeVariable "a" @@ -38,7 +38,7 @@ 28:13-14 TVariable "x" 29:1-3 TFunction "aa" 29:7-11 TTypeVariable "cool" -29:15-18 TTypeCon "Int" +29:15-18 TTypeConstructor "Int" 29:22-26 TTypeVariable "cool" 30:1-3 TFunction "aa" 30:4-5 TVariable "x" @@ -52,28 +52,28 @@ 34:2-4 TVariable "zz" 34:6-8 TVariable "kk" 35:1-3 TFunction "cc" -35:7-10 TTypeCon "Foo" -35:15-18 TTypeCon "Int" -35:20-23 TTypeCon "Int" -35:28-31 TTypeCon "Int" +35:7-10 TTypeConstructor "Foo" +35:15-18 TTypeConstructor "Int" +35:20-23 TTypeConstructor "Int" +35:28-31 TTypeConstructor "Int" 36:1-3 TFunction "cc" 36:4-5 TVariable "f" 36:7-9 TVariable "gg" 36:11-13 TVariable "vv" 37:10-12 TVariable "gg" -38:14-17 TRecField "foo" +38:14-17 TRecordField "foo" 38:18-19 TFunction "$" 38:20-21 TVariable "f" -38:24-27 TRecField "foo" -39:14-17 TRecField "foo" +38:24-27 TRecordField "foo" +39:14-17 TRecordField "foo" 39:18-19 TFunction "$" 39:20-21 TVariable "f" -39:24-27 TRecField "foo" +39:24-27 TRecordField "foo" 41:1-3 TFunction "go" -41:6-9 TRecField "foo" +41:6-9 TRecordField "foo" 42:1-4 TFunction "add" 42:7-18 TClassMethod "(Prelude.+)" 47:1-5 TVariable "main" -47:9-11 TTypeCon "IO" +47:9-11 TTypeConstructor "IO" 48:1-5 TVariable "main" 48:8-16 TFunction "putStrLn" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TClass.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TClass.expected index d5f6e51002..e369963b0e 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TClass.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TClass.expected @@ -2,4 +2,4 @@ 4:11-12 TTypeVariable "a" 5:3-6 TClassMethod "foo" 5:10-11 TTypeVariable "a" -5:15-18 TTypeCon "Int" +5:15-18 TTypeConstructor "Int" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TClassImportedDeriving.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TClassImportedDeriving.expected index 5e9c894bf4..3bbeb3e66c 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TClassImportedDeriving.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TClassImportedDeriving.expected @@ -1,3 +1,3 @@ -4:6-9 TTypeCon "Foo" -4:12-15 TDataCon "Foo" +4:6-9 TTypeConstructor "Foo" +4:12-15 TDataConstructor "Foo" 4:26-30 TClass "Show" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TDataFamily.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TDataFamily.expected index b2b0c25d18..c95c0689f0 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TDataFamily.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TDataFamily.expected @@ -1,12 +1,12 @@ 5:13-18 TTypeFamily "XList" 5:19-20 TTypeVariable "a" 8:15-20 TTypeFamily "XList" -8:21-25 TTypeCon "Char" -8:28-33 TDataCon "XCons" -8:35-39 TTypeCon "Char" +8:21-25 TTypeConstructor "Char" +8:28-33 TDataConstructor "XCons" +8:35-39 TTypeConstructor "Char" 8:42-47 TTypeFamily "XList" -8:48-52 TTypeCon "Char" -8:56-60 TDataCon "XNil" +8:48-52 TTypeConstructor "Char" +8:56-60 TDataConstructor "XNil" 11:15-20 TTypeFamily "XList" -11:26-35 TDataCon "XListUnit" -11:37-40 TTypeCon "Int" +11:26-35 TDataConstructor "XListUnit" +11:37-40 TTypeConstructor "Int" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TDataType.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TDataType.expected index f8f844c423..bdf280c45e 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TDataType.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TDataType.expected @@ -1,4 +1,4 @@ -3:6-9 TTypeCon "Foo" -3:12-15 TDataCon "Foo" -3:16-19 TTypeCon "Int" +3:6-9 TTypeConstructor "Foo" +3:12-15 TDataConstructor "Foo" +3:16-19 TTypeConstructor "Int" 3:30-32 TClass "Eq" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TDatafamily.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/TDatafamily.hs deleted file mode 100644 index b9047a72d2..0000000000 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TDatafamily.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} -module TDatafamily where - --- Declare a list-like data family -data family XList a - --- Declare a list-like instance for Char -data instance XList Char = XCons !Char !(XList Char) | XNil - --- Declare a number-like instance for () -data instance XList () = XListUnit !Int diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TDatatype.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/TDatatype.hs deleted file mode 100644 index 894065e391..0000000000 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TDatatype.hs +++ /dev/null @@ -1,3 +0,0 @@ -module TDataType where - -data Foo = Foo Int deriving (Eq) diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TDatatypeImported.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TDatatypeImported.expected index 7c00ac76a2..9c2118cd3a 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TDatatypeImported.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TDatatypeImported.expected @@ -1,4 +1,4 @@ 5:1-3 TVariable "go" -5:7-9 TTypeCon "IO" +5:7-9 TTypeConstructor "IO" 6:1-3 TVariable "go" 6:6-11 TFunction "print" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLet.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLet.expected index 002da409ca..3f27b723db 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLet.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLet.expected @@ -1,5 +1,5 @@ 3:1-2 TVariable "y" -3:6-9 TTypeCon "Int" +3:6-9 TTypeConstructor "Int" 4:1-2 TVariable "y" 4:9-10 TFunction "f" 4:11-12 TVariable "x" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLocal.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLocal.expected index 74fbb3a6aa..176606e396 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLocal.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TFunctionLocal.expected @@ -1,6 +1,6 @@ 3:1-2 TFunction "f" -3:6-9 TTypeCon "Int" -3:13-16 TTypeCon "Int" +3:6-9 TTypeConstructor "Int" +3:13-16 TTypeConstructor "Int" 4:1-2 TFunction "f" 4:7-8 TFunction "g" 6:5-6 TFunction "g" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TGADT.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TGADT.expected index a8a3d37c63..ad3ac0f086 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TGADT.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TGADT.expected @@ -1,13 +1,13 @@ -5:6-9 TTypeCon "Lam" -6:3-7 TDataCon "Lift" +5:6-9 TTypeConstructor "Lam" +6:3-7 TDataConstructor "Lift" 6:11-12 TTypeVariable "a" -6:36-39 TTypeCon "Lam" +6:36-39 TTypeConstructor "Lam" 6:40-41 TTypeVariable "a" -7:3-6 TDataCon "Lam" -7:12-15 TTypeCon "Lam" +7:3-6 TDataConstructor "Lam" +7:12-15 TTypeConstructor "Lam" 7:16-17 TTypeVariable "a" -7:21-24 TTypeCon "Lam" +7:21-24 TTypeConstructor "Lam" 7:25-26 TTypeVariable "b" -7:36-39 TTypeCon "Lam" +7:36-39 TTypeConstructor "Lam" 7:41-42 TTypeVariable "a" 7:46-47 TTypeVariable "b" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodBind.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodBind.expected index d0cfc85d3b..a1392ff1d9 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodBind.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TInstanceClassMethodBind.expected @@ -1,7 +1,7 @@ -4:6-9 TTypeCon "Foo" -4:12-15 TDataCon "Foo" -4:16-19 TTypeCon "Int" +4:6-9 TTypeConstructor "Foo" +4:12-15 TDataConstructor "Foo" +4:16-19 TTypeConstructor "Int" 5:10-12 TClass "Eq" -5:13-16 TTypeCon "Foo" +5:13-16 TTypeConstructor "Foo" 6:5-9 TClassMethod "(==)" 6:12-21 TVariable "undefined" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternMatch.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternMatch.expected index eb3d90cbc7..0535662e63 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternMatch.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternMatch.expected @@ -1,2 +1,2 @@ 4:1-2 TFunction "g" -4:4-11 TDataCon "Nothing" +4:4-11 TDataConstructor "Nothing" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSyn.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSyn.expected deleted file mode 100644 index 11502922e2..0000000000 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSyn.expected +++ /dev/null @@ -1 +0,0 @@ -5:9-12 TPatternSyn "Foo" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSyn.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSyn.hs deleted file mode 100644 index 9590467307..0000000000 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSyn.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} -module TPatternSyn where - - -pattern Foo = 1 - - diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSynonym.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSynonym.expected new file mode 100644 index 0000000000..7cdf5260cb --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSynonym.expected @@ -0,0 +1 @@ +5:9-12 TPatternSynonym "Foo" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternsyn.hs b/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSynonym.hs similarity index 64% rename from plugins/hls-semantic-tokens-plugin/test/testdata/TPatternsyn.hs rename to plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSynonym.hs index 9590467307..adff673ce8 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternsyn.hs +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSynonym.hs @@ -1,5 +1,5 @@ {-# LANGUAGE PatternSynonyms #-} -module TPatternSyn where +module TPatternSynonym where pattern Foo = 1 diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TRecord.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TRecord.expected index 683d1c142a..43b8e4d3b0 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TRecord.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TRecord.expected @@ -1,4 +1,4 @@ -4:6-9 TTypeCon "Foo" -4:12-15 TDataCon "Foo" -4:18-21 TRecField "foo" -4:25-28 TTypeCon "Int" +4:6-9 TTypeConstructor "Foo" +4:12-15 TDataConstructor "Foo" +4:18-21 TRecordField "foo" +4:25-28 TTypeConstructor "Int" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TRecordDuplicateRecordFields.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TRecordDuplicateRecordFields.expected index 228a593b19..70fdc63e18 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TRecordDuplicateRecordFields.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TRecordDuplicateRecordFields.expected @@ -1,4 +1,4 @@ -5:6-9 TTypeCon "Foo" -5:12-15 TDataCon "Foo" -5:18-21 TRecField "boo" -5:26-32 TTypeSyn "String" +5:6-9 TTypeConstructor "Foo" +5:12-15 TDataConstructor "Foo" +5:18-21 TRecordField "boo" +5:26-32 TTypeSynonym "String" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TTypefamily.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TTypefamily.expected index edd5a2a169..08019bc3f3 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TTypefamily.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TTypefamily.expected @@ -1,8 +1,8 @@ 4:13-16 TTypeFamily "Foo" 4:17-18 TTypeVariable "a" 5:3-6 TTypeFamily "Foo" -5:7-10 TTypeCon "Int" -5:13-16 TTypeCon "Int" +5:7-10 TTypeConstructor "Int" +5:13-16 TTypeConstructor "Int" 6:3-6 TTypeFamily "Foo" 6:7-8 TTypeVariable "a" -6:11-17 TTypeSyn "String" +6:11-17 TTypeSynonym "String" diff --git a/plugins/hls-semantic-tokens-plugin/test/testdata/TValBind.expected b/plugins/hls-semantic-tokens-plugin/test/testdata/TValBind.expected index 993cf807ef..ec20b01e56 100644 --- a/plugins/hls-semantic-tokens-plugin/test/testdata/TValBind.expected +++ b/plugins/hls-semantic-tokens-plugin/test/testdata/TValBind.expected @@ -1,4 +1,4 @@ 4:1-6 TVariable "hello" -4:10-13 TTypeCon "Int" +4:10-13 TTypeConstructor "Int" 5:1-6 TVariable "hello" 5:9-15 TClassMethod "length" diff --git a/test/testdata/schema/ghc92/default-config.golden.json b/test/testdata/schema/ghc92/default-config.golden.json index 949df9ed88..d4e9e717b7 100644 --- a/test/testdata/schema/ghc92/default-config.golden.json +++ b/test/testdata/schema/ghc92/default-config.golden.json @@ -115,6 +115,19 @@ "globalOn": true }, "semanticTokens": { + "config": { + "classMethodToken": "method", + "classToken": "class", + "dataConstructorToken": "enumMember", + "functionToken": "function", + "patternSynonymToken": "macro", + "recordFieldToken": "property", + "typeConstructorToken": "enum", + "typeFamilyToken": "interface", + "typeSynonymToken": "type", + "typeVariableToken": "typeParameter", + "variableToken": "variable" + }, "globalOn": false }, "splice": { diff --git a/test/testdata/schema/ghc92/vscode-extension-schema.golden.json b/test/testdata/schema/ghc92/vscode-extension-schema.golden.json index 01c36f1562..c063ad0b5a 100644 --- a/test/testdata/schema/ghc92/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc92/vscode-extension-schema.golden.json @@ -249,6 +249,622 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.semanticTokens.config.classMethodToken": { + "default": "method", + "description": "LSP semantic token type to use for typeclass methods", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.classToken": { + "default": "class", + "description": "LSP semantic token type to use for typeclasses", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.dataConstructorToken": { + "default": "enumMember", + "description": "LSP semantic token type to use for data constructors", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.functionToken": { + "default": "function", + "description": "LSP semantic token type to use for functions", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.patternSynonymToken": { + "default": "macro", + "description": "LSP semantic token type to use for pattern synonyms", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.recordFieldToken": { + "default": "property", + "description": "LSP semantic token type to use for record fields", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeConstructorToken": { + "default": "enum", + "description": "LSP semantic token type to use for type constructors", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeFamilyToken": { + "default": "interface", + "description": "LSP semantic token type to use for type families", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeSynonymToken": { + "default": "type", + "description": "LSP semantic token type to use for type synonyms", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeVariableToken": { + "default": "typeParameter", + "description": "LSP semantic token type to use for type variables", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.variableToken": { + "default": "variable", + "description": "LSP semantic token type to use for variables", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, "haskell.plugin.semanticTokens.globalOn": { "default": false, "description": "Enables semanticTokens plugin", diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json index 96f2567cec..6b1a3c3b5f 100644 --- a/test/testdata/schema/ghc94/default-config.golden.json +++ b/test/testdata/schema/ghc94/default-config.golden.json @@ -115,6 +115,19 @@ "globalOn": true }, "semanticTokens": { + "config": { + "classMethodToken": "method", + "classToken": "class", + "dataConstructorToken": "enumMember", + "functionToken": "function", + "patternSynonymToken": "macro", + "recordFieldToken": "property", + "typeConstructorToken": "enum", + "typeFamilyToken": "interface", + "typeSynonymToken": "type", + "typeVariableToken": "typeParameter", + "variableToken": "variable" + }, "globalOn": false }, "splice": { diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json index 349b07571d..6b3cdc4384 100644 --- a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json @@ -249,6 +249,622 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.semanticTokens.config.classMethodToken": { + "default": "method", + "description": "LSP semantic token type to use for typeclass methods", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.classToken": { + "default": "class", + "description": "LSP semantic token type to use for typeclasses", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.dataConstructorToken": { + "default": "enumMember", + "description": "LSP semantic token type to use for data constructors", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.functionToken": { + "default": "function", + "description": "LSP semantic token type to use for functions", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.patternSynonymToken": { + "default": "macro", + "description": "LSP semantic token type to use for pattern synonyms", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.recordFieldToken": { + "default": "property", + "description": "LSP semantic token type to use for record fields", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeConstructorToken": { + "default": "enum", + "description": "LSP semantic token type to use for type constructors", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeFamilyToken": { + "default": "interface", + "description": "LSP semantic token type to use for type families", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeSynonymToken": { + "default": "type", + "description": "LSP semantic token type to use for type synonyms", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeVariableToken": { + "default": "typeParameter", + "description": "LSP semantic token type to use for type variables", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.variableToken": { + "default": "variable", + "description": "LSP semantic token type to use for variables", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, "haskell.plugin.semanticTokens.globalOn": { "default": false, "description": "Enables semanticTokens plugin", diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json index 96f2567cec..6b1a3c3b5f 100644 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -115,6 +115,19 @@ "globalOn": true }, "semanticTokens": { + "config": { + "classMethodToken": "method", + "classToken": "class", + "dataConstructorToken": "enumMember", + "functionToken": "function", + "patternSynonymToken": "macro", + "recordFieldToken": "property", + "typeConstructorToken": "enum", + "typeFamilyToken": "interface", + "typeSynonymToken": "type", + "typeVariableToken": "typeParameter", + "variableToken": "variable" + }, "globalOn": false }, "splice": { diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json index 349b07571d..6b3cdc4384 100644 --- a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json @@ -249,6 +249,622 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.semanticTokens.config.classMethodToken": { + "default": "method", + "description": "LSP semantic token type to use for typeclass methods", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.classToken": { + "default": "class", + "description": "LSP semantic token type to use for typeclasses", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.dataConstructorToken": { + "default": "enumMember", + "description": "LSP semantic token type to use for data constructors", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.functionToken": { + "default": "function", + "description": "LSP semantic token type to use for functions", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.patternSynonymToken": { + "default": "macro", + "description": "LSP semantic token type to use for pattern synonyms", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.recordFieldToken": { + "default": "property", + "description": "LSP semantic token type to use for record fields", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeConstructorToken": { + "default": "enum", + "description": "LSP semantic token type to use for type constructors", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeFamilyToken": { + "default": "interface", + "description": "LSP semantic token type to use for type families", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeSynonymToken": { + "default": "type", + "description": "LSP semantic token type to use for type synonyms", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeVariableToken": { + "default": "typeParameter", + "description": "LSP semantic token type to use for type variables", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.variableToken": { + "default": "variable", + "description": "LSP semantic token type to use for variables", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, "haskell.plugin.semanticTokens.globalOn": { "default": false, "description": "Enables semanticTokens plugin", diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json index 31c5a79400..0a8cd9afe7 100644 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -80,6 +80,19 @@ "globalOn": true }, "semanticTokens": { + "config": { + "classMethodToken": "method", + "classToken": "class", + "dataConstructorToken": "enumMember", + "functionToken": "function", + "patternSynonymToken": "macro", + "recordFieldToken": "property", + "typeConstructorToken": "enum", + "typeFamilyToken": "interface", + "typeSynonymToken": "type", + "typeVariableToken": "typeParameter", + "variableToken": "variable" + }, "globalOn": false }, "stan": { diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json index b01b0f0189..962f3138b3 100644 --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -171,6 +171,622 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.semanticTokens.config.classMethodToken": { + "default": "method", + "description": "LSP semantic token type to use for typeclass methods", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.classToken": { + "default": "class", + "description": "LSP semantic token type to use for typeclasses", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.dataConstructorToken": { + "default": "enumMember", + "description": "LSP semantic token type to use for data constructors", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.functionToken": { + "default": "function", + "description": "LSP semantic token type to use for functions", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.patternSynonymToken": { + "default": "macro", + "description": "LSP semantic token type to use for pattern synonyms", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.recordFieldToken": { + "default": "property", + "description": "LSP semantic token type to use for record fields", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeConstructorToken": { + "default": "enum", + "description": "LSP semantic token type to use for type constructors", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeFamilyToken": { + "default": "interface", + "description": "LSP semantic token type to use for type families", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeSynonymToken": { + "default": "type", + "description": "LSP semantic token type to use for type synonyms", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeVariableToken": { + "default": "typeParameter", + "description": "LSP semantic token type to use for type variables", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.variableToken": { + "default": "variable", + "description": "LSP semantic token type to use for variables", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, "haskell.plugin.semanticTokens.globalOn": { "default": false, "description": "Enables semanticTokens plugin",