From 6ec4ac9e4668948427aea5e919e61e5bf38ca2af Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 10 Jan 2024 20:55:03 +0800 Subject: [PATCH 01/24] add config for semantic tokens for mapping between hs token type to LSP default token type --- .../hls-semantic-tokens-plugin.cabal | 5 + .../src/Ide/Plugin/SemanticTokens.hs | 6 +- .../src/Ide/Plugin/SemanticTokens/Internal.hs | 29 +++-- .../src/Ide/Plugin/SemanticTokens/Mappings.hs | 77 ++++++------ .../src/Ide/Plugin/SemanticTokens/Query.hs | 13 +- .../src/Ide/Plugin/SemanticTokens/Types.hs | 103 ++++++++++++++-- .../hls-semantic-tokens-plugin/test/Main.hs | 113 +++++++++++------- stack-lts21.yaml | 2 + stack.yaml | 2 + 9 files changed, 240 insertions(+), 110 deletions(-) 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..bc825e75be 100644 --- a/plugins/hls-semantic-tokens-plugin/hls-semantic-tokens-plugin.cabal +++ b/plugins/hls-semantic-tokens-plugin/hls-semantic-tokens-plugin.cabal @@ -52,12 +52,15 @@ library , array , deepseq , hls-graph == 2.5.0.0 + , data-default + , rank2classes 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 +86,5 @@ test-suite tests , bytestring , ghcide == 2.5.0.0 , hls-plugin-api == 2.5.0.0 + , rank2classes + , 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..72388cf8d5 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,7 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeData #-} module Ide.Plugin.SemanticTokens (descriptor) where @@ -11,10 +14,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 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..4a82b85d5b 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,10 +1,9 @@ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -18,11 +17,10 @@ module Ide.Plugin.SemanticTokens.Internal (semanticTokensFull, getSemanticTokens 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 Data.Aeson (ToJSON (toJSON)) import qualified Data.Map as Map -import qualified Data.Text as T import Development.IDE (Action, GetDocMap (GetDocMap), GetHieAst (GetHieAst), @@ -32,8 +30,8 @@ import Development.IDE (Action, Rules, WithPriority, cmapWithPrio, define, fromNormalizedFilePath, - hieKind, ideLogger, - logPriority, use_) + hieKind, logPriority, + usePropertyAction, use_) import Development.IDE.Core.PluginUtils (runActionE, useWithStaleE) import Development.IDE.Core.PositionMapping (idDelta) @@ -60,23 +58,24 @@ import Language.LSP.Protocol.Types (NormalizedFilePath, type (|?) (InL)) import Prelude hiding (span) -logActionWith :: (MonadIO m) => IdeState -> Priority -> String -> m () -logActionWith st prior = liftIO . logPriority (ideLogger st) prior . T.pack ----------------------- ---- 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 + logWith recorder Debug (LogMsg "computeSemanticTokens start") + config :: SemanticTokensConfig <- lift $ usePropertyAction #tokenMapping pid semanticConfigProperties + logWith recorder Debug (LogMsg $ show $ toJSON config) + 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..a31ba4d78c 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 @@ -12,6 +12,8 @@ module Ide.Plugin.SemanticTokens.Mappings where import qualified Data.Array as A +import Data.Default (def) +import Data.Functor.Identity (Identity (runIdentity)) import Data.List.Extra (chunksOf, (!?)) import qualified Data.Map as Map import Data.Maybe (mapMaybe) @@ -32,30 +34,22 @@ 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 +toLspTokenType :: SemanticTokensConfig -> HsSemanticTokenType -> SemanticTokenTypes +toLspTokenType conf tk = case tk of + TFunction -> runIdentity $ stFunction conf + TVariable -> runIdentity $ stVariable conf + TClassMethod -> runIdentity $ stClassMethod conf + TTypeVariable -> runIdentity $ stTypeVariable conf + TDataCon -> runIdentity $ stDataCon conf + TClass -> runIdentity $ stClass conf + TTypeCon -> runIdentity $ stTypeCon conf + TTypeSyn -> runIdentity $ stTypeSyn conf + TTypeFamily -> runIdentity $ stTypeFamily conf + TRecField -> runIdentity $ stRecField conf + TPatternSyn -> runIdentity $ stPatternSyn conf lspTokenReverseMap :: Map.Map SemanticTokenTypes HsSemanticTokenType -lspTokenReverseMap = Map.fromList $ map (\x -> (toLspTokenType x, x)) $ enumFrom minBound +lspTokenReverseMap = Map.fromList $ map (\x -> (toLspTokenType def x, x)) $ enumFrom minBound fromLspTokenType :: SemanticTokenTypes -> Maybe HsSemanticTokenType fromLspTokenType tk = Map.lookup tk lspTokenReverseMap @@ -158,21 +152,37 @@ infoTokenType x = case x of -- * 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 +-- this use the default token type mapping +recoverSemanticTokens :: VirtualFile -> SemanticTokens -> Either Text [SemanticTokenOriginal HsSemanticTokenType] +recoverSemanticTokens v s = do + tks <- recoverLspSemanticTokens v s + return $ map fromLspTokenTypeStrict tks + +-- | fromLspTokenTypeStrict +-- for debug and test. +-- use the default token type mapping to convert lsp token type to haskell token type +fromLspTokenTypeStrict :: SemanticTokenOriginal SemanticTokenTypes -> SemanticTokenOriginal HsSemanticTokenType +fromLspTokenTypeStrict (SemanticTokenOriginal tokenType location name) = + case fromLspTokenType 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 +193,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 7758176d04..9ded3538af 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) @@ -95,14 +96,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 = @@ -111,5 +112,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/Types.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs index a6fb63c0c0..75a959c1ed 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,22 +1,48 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} module Ide.Plugin.SemanticTokens.Types where import Control.DeepSeq (NFData (rnf), rwhnf) +import Control.Monad.Identity (Identity (..)) +import Data.Aeson (FromJSON (parseJSON), + Options (..), ToJSON, + defaultOptions, + genericParseJSON, genericToJSON) +import Data.Aeson.Types (ToJSON (toJSON)) import qualified Data.Array as A +import Data.Char (toLower) +import Data.Default (Default (def)) import Data.Generics (Typeable) import qualified Data.Map as M +import Data.Maybe (fromMaybe) import Development.IDE (Pretty (pretty), RuleResult) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat hiding (loc) import Development.IDE.Graph.Classes (Hashable) import GHC.Generics (Generic) +import Ide.Plugin.Properties (Properties, + PropertyKey (PropertyKey), + PropertyType (TObject), + defineObjectProperty, + emptyProperties, (&)) import Language.LSP.Protocol.Types +import qualified Rank2 +import qualified Rank2.TH -- !!!! order of declarations matters deriving enum and ord -- since token may come from different source and we want to keep the most specific one @@ -35,19 +61,73 @@ data HsSemanticTokenType | TRecField -- from match bind deriving (Eq, Ord, Show, Enum, Bounded) +type SemanticTokensConfig = SemanticTokensConfig_ Identity +instance Default SemanticTokensConfig where + def = STC + { stFunction = Identity SemanticTokenTypes_Function + , stVariable = Identity SemanticTokenTypes_Variable + , stDataCon = Identity SemanticTokenTypes_EnumMember + , stTypeVariable = Identity SemanticTokenTypes_TypeParameter + , stClassMethod = Identity SemanticTokenTypes_Method + -- pattern syn is like a limited version of macro of constructing a term + , stPatternSyn = Identity 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 + , stTypeCon = Identity SemanticTokenTypes_Enum + , stClass = Identity SemanticTokenTypes_Class + , stTypeSyn = Identity SemanticTokenTypes_Type + , stTypeFamily = Identity SemanticTokenTypes_Interface + , stRecField = Identity 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_ f = STC + { stFunction :: !(f SemanticTokenTypes) + , stVariable :: !(f SemanticTokenTypes) + , stDataCon :: !(f SemanticTokenTypes) + , stTypeVariable :: !(f SemanticTokenTypes) + , stClassMethod :: !(f SemanticTokenTypes) + , stPatternSyn :: !(f SemanticTokenTypes) + , stTypeCon :: !(f SemanticTokenTypes) + , stClass :: !(f SemanticTokenTypes) + , stTypeSyn :: !(f SemanticTokenTypes) + , stTypeFamily :: !(f SemanticTokenTypes) + , stRecField :: !(f SemanticTokenTypes) + } deriving Generic +$(Rank2.TH.deriveAll ''SemanticTokensConfig_) + +withDef :: SemanticTokensConfig -> SemanticTokensConfig_ Maybe -> SemanticTokensConfig +withDef = Rank2.liftA2 (\x y -> Identity (fromMaybe (runIdentity x) y)) +instance FromJSON SemanticTokensConfig where parseJSON = fmap (withDef def) . parseJSON +stOption :: Options +stOption = defaultOptions { fieldLabelModifier = map toLower . drop 2 } +instance FromJSON (SemanticTokensConfig_ Maybe) where parseJSON = genericParseJSON stOption +instance ToJSON (SemanticTokensConfig_ Maybe) where toJSON = genericToJSON stOption +instance ToJSON SemanticTokensConfig where toJSON = genericToJSON stOption + +semanticConfigProperties :: Properties '[ 'PropertyKey "tokenMapping" ('TObject SemanticTokensConfig)] +semanticConfigProperties = + emptyProperties + & defineObjectProperty + #tokenMapping + "Configuration of map from hs semantic token type to LSP default token type" + def +deriving instance Show SemanticTokensConfig + 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 +167,8 @@ data HieFunMaskKind kind where data SemanticLog = LogShake Shake.Log | LogNoAST FilePath + | LogConfig (SemanticTokensConfig ) + | LogMsg String | LogNoVF deriving (Show) @@ -95,3 +177,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 56a8f47393..0aafccc966 100644 --- a/plugins/hls-semantic-tokens-plugin/test/Main.hs +++ b/plugins/hls-semantic-tokens-plugin/test/Main.hs @@ -5,60 +5,48 @@ {-# 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 (..), +import Language.LSP.Protocol.Types (SemanticTokenTypes (..), SemanticTokensParams (..), - _L, type (|?) (..)) -import qualified Language.LSP.Server as Lsp -import Language.LSP.Test (Session (..), openDoc) + _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,17 +69,13 @@ 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 = @@ -106,13 +90,18 @@ goldenWithSemanticTokens title path = docSemanticTokensString :: TextDocumentIdentifier -> Session String docSemanticTokensString doc = do + xs <- map fromLspTokenTypeStrict <$> docLspSemanticTokensString doc + return $ unlines . map show $ xs + +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 @@ -141,14 +130,49 @@ semanticTokensValuePatternTests = goldenWithSemanticTokens "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 [ "tokenMapping" .= object ["function" .= 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 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 = @@ -158,16 +182,16 @@ semanticTokensTests = 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) @@ -182,6 +206,7 @@ semanticTokensTests = goldenWithSemanticTokens "TUnicodeSyntax" "TUnicodeSyntax" ] +semanticTokensDataTypeTests :: TestTree semanticTokensDataTypeTests = testGroup "get semantic Tokens" @@ -192,6 +217,7 @@ semanticTokensDataTypeTests = goldenWithSemanticTokens "GADT" "TGADT" ] +semanticTokensFunctionTests :: TestTree semanticTokensFunctionTests = testGroup "get semantic of functions" @@ -210,5 +236,6 @@ main = semanticTokensClassTests, semanticTokensDataTypeTests, semanticTokensValuePatternTests, - semanticTokensFunctionTests + semanticTokensFunctionTests, + semanticTokensConfigTest ] diff --git a/stack-lts21.yaml b/stack-lts21.yaml index b114550a17..f69b8a676e 100644 --- a/stack-lts21.yaml +++ b/stack-lts21.yaml @@ -54,6 +54,8 @@ extra-deps: - lsp-2.3.0.0 - lsp-test-0.16.0.1 - lsp-types-2.1.0.0 +- rank2classes-1.5.3 +- data-functor-logistic-0.0 # stan dependencies not found in the stackage snapshot - stan-0.1.2.0 diff --git a/stack.yaml b/stack.yaml index 6eae9d00dd..93a4efca51 100644 --- a/stack.yaml +++ b/stack.yaml @@ -57,6 +57,8 @@ extra-deps: - monad-dijkstra-0.1.1.4 - hw-prim-0.6.3.2 - optparse-applicative-0.17.1.0 +- rank2classes-1.5.3 +- data-functor-logistic-0.0 # stan and friends - stan-0.1.2.0 From c92429c8e40bcb53bfd2de021b61d29f417bd53e Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 10 Jan 2024 21:11:09 +0800 Subject: [PATCH 02/24] fix Missing features header --- docs/features.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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! From d6ee0951a7a3dc2251dd3566549e6d5f22504987 Mon Sep 17 00:00:00 2001 From: Patrick Wales Date: Wed, 10 Jan 2024 21:19:27 +0800 Subject: [PATCH 03/24] Delete plugins/hls-semantic-tokens-plugin/test/testdata/TDatatype.hs --- plugins/hls-semantic-tokens-plugin/test/testdata/TDatatype.hs | 3 --- 1 file changed, 3 deletions(-) delete mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/TDatatype.hs 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) From 0183de1f13128a5dffe43f6fa767459a2976e9fa Mon Sep 17 00:00:00 2001 From: Patrick Wales Date: Wed, 10 Jan 2024 21:19:38 +0800 Subject: [PATCH 04/24] Delete plugins/hls-semantic-tokens-plugin/test/testdata/TDatafamily.hs --- .../test/testdata/TDatafamily.hs | 11 ----------- 1 file changed, 11 deletions(-) delete mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/TDatafamily.hs 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 From 63dc0a215e7d7279e7922b3f87a571b26406a106 Mon Sep 17 00:00:00 2001 From: Patrick Wales Date: Wed, 10 Jan 2024 21:20:10 +0800 Subject: [PATCH 05/24] Delete plugins/hls-semantic-tokens-plugin/test/testdata/TPatternsyn.hs --- .../test/testdata/TPatternsyn.hs | 7 ------- 1 file changed, 7 deletions(-) delete mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/TPatternsyn.hs 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 - - From 5e0208c7358d0c3e3d8438a3b25bba5edad9443a Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 10 Jan 2024 21:38:56 +0800 Subject: [PATCH 06/24] update doc --- .../src/Ide/Plugin/SemanticTokens/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 75a959c1ed..bd3b2e6e7a 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 @@ -111,7 +111,7 @@ semanticConfigProperties = emptyProperties & defineObjectProperty #tokenMapping - "Configuration of map from hs semantic token type to LSP default token type" + "Configuration of the map from hs semantic token type to LSP default token type" def deriving instance Show SemanticTokensConfig From 03b7964eb98fcef88f60eee57183c3be96d96479 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 10 Jan 2024 21:56:11 +0800 Subject: [PATCH 07/24] fix ghc96 schema generation --- .../schema/ghc92/default-config.golden.json | 124 -------- .../ghc92/vscode-extension-schema.golden.json | 264 ----------------- .../schema/ghc94/default-config.golden.json | 127 -------- .../ghc94/vscode-extension-schema.golden.json | 270 ------------------ .../schema/ghc96/default-config.golden.json | 15 + .../ghc96/vscode-extension-schema.golden.json | 18 ++ .../schema/ghc98/default-config.golden.json | 89 ------ .../ghc98/vscode-extension-schema.golden.json | 186 ------------ 8 files changed, 33 insertions(+), 1060 deletions(-) delete mode 100644 test/testdata/schema/ghc92/default-config.golden.json delete mode 100644 test/testdata/schema/ghc92/vscode-extension-schema.golden.json delete mode 100644 test/testdata/schema/ghc94/default-config.golden.json delete mode 100644 test/testdata/schema/ghc94/vscode-extension-schema.golden.json delete mode 100644 test/testdata/schema/ghc98/default-config.golden.json delete mode 100644 test/testdata/schema/ghc98/vscode-extension-schema.golden.json diff --git a/test/testdata/schema/ghc92/default-config.golden.json b/test/testdata/schema/ghc92/default-config.golden.json deleted file mode 100644 index 949df9ed88..0000000000 --- a/test/testdata/schema/ghc92/default-config.golden.json +++ /dev/null @@ -1,124 +0,0 @@ -{ - "checkParents": "CheckOnSave", - "checkProject": true, - "formattingProvider": "ormolu", - "maxCompletions": 40, - "plugin": { - "alternateNumberFormat": { - "globalOn": true - }, - "cabal": { - "codeActionsOn": true, - "completionOn": true - }, - "callHierarchy": { - "globalOn": true - }, - "changeTypeSignature": { - "globalOn": true - }, - "class": { - "codeActionsOn": true, - "codeLensOn": true - }, - "eval": { - "config": { - "diff": true, - "exception": false - }, - "globalOn": true - }, - "explicit-fields": { - "globalOn": true - }, - "explicit-fixity": { - "globalOn": true - }, - "fourmolu": { - "config": { - "external": false - } - }, - "gadt": { - "globalOn": true - }, - "ghcide-code-actions-bindings": { - "globalOn": true - }, - "ghcide-code-actions-fill-holes": { - "globalOn": true - }, - "ghcide-code-actions-imports-exports": { - "globalOn": true - }, - "ghcide-code-actions-type-signatures": { - "globalOn": true - }, - "ghcide-completions": { - "config": { - "autoExtendOn": true, - "snippetsOn": true - }, - "globalOn": true - }, - "ghcide-hover-and-symbols": { - "hoverOn": true, - "symbolsOn": true - }, - "ghcide-type-lenses": { - "config": { - "mode": "always" - }, - "globalOn": true - }, - "hlint": { - "codeActionsOn": true, - "config": { - "flags": [] - }, - "diagnosticsOn": true - }, - "importLens": { - "codeActionsOn": true, - "codeLensOn": true - }, - "moduleName": { - "globalOn": true - }, - "ormolu": { - "config": { - "external": false - } - }, - "overloaded-record-dot": { - "globalOn": true - }, - "pragmas-completion": { - "globalOn": true - }, - "pragmas-disable": { - "globalOn": true - }, - "pragmas-suggest": { - "globalOn": true - }, - "qualifyImportedNames": { - "globalOn": true - }, - "rename": { - "config": { - "crossModule": false - }, - "globalOn": true - }, - "retrie": { - "globalOn": true - }, - "semanticTokens": { - "globalOn": false - }, - "splice": { - "globalOn": true - } - } -} diff --git a/test/testdata/schema/ghc92/vscode-extension-schema.golden.json b/test/testdata/schema/ghc92/vscode-extension-schema.golden.json deleted file mode 100644 index 01c36f1562..0000000000 --- a/test/testdata/schema/ghc92/vscode-extension-schema.golden.json +++ /dev/null @@ -1,264 +0,0 @@ -{ - "haskell.plugin.alternateNumberFormat.globalOn": { - "default": true, - "description": "Enables alternateNumberFormat plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.codeActionsOn": { - "default": true, - "description": "Enables cabal code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.completionOn": { - "default": true, - "description": "Enables cabal completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.callHierarchy.globalOn": { - "default": true, - "description": "Enables callHierarchy plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.changeTypeSignature.globalOn": { - "default": true, - "description": "Enables changeTypeSignature plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeActionsOn": { - "default": true, - "description": "Enables class code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeLensOn": { - "default": true, - "description": "Enables class code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.diff": { - "default": true, - "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.exception": { - "default": false, - "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.globalOn": { - "default": true, - "description": "Enables eval plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fields.globalOn": { - "default": true, - "description": "Enables explicit-fields plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fixity.globalOn": { - "default": true, - "description": "Enables explicit-fixity plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.fourmolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.gadt.globalOn": { - "default": true, - "description": "Enables gadt plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-bindings.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-bindings plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-fill-holes plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-imports-exports plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-type-signatures plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.autoExtendOn": { - "default": true, - "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.snippetsOn": { - "default": true, - "markdownDescription": "Inserts snippets when using code completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.globalOn": { - "default": true, - "description": "Enables ghcide-completions plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols hover", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols symbols", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-type-lenses.config.mode": { - "default": "always", - "description": "Control how type lenses are shown", - "enum": [ - "always", - "exported", - "diagnostics" - ], - "enumDescriptions": [ - "Always displays type lenses of global bindings", - "Only display type lenses of exported global bindings", - "Follows error messages produced by GHC about missing signatures" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.ghcide-type-lenses.globalOn": { - "default": true, - "description": "Enables ghcide-type-lenses plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.codeActionsOn": { - "default": true, - "description": "Enables hlint code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.config.flags": { - "default": [], - "markdownDescription": "Flags used by hlint", - "scope": "resource", - "type": "array" - }, - "haskell.plugin.hlint.diagnosticsOn": { - "default": true, - "description": "Enables hlint diagnostics", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeActionsOn": { - "default": true, - "description": "Enables importLens code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeLensOn": { - "default": true, - "description": "Enables importLens code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.moduleName.globalOn": { - "default": true, - "description": "Enables moduleName plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ormolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.overloaded-record-dot.globalOn": { - "default": true, - "description": "Enables overloaded-record-dot plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-completion.globalOn": { - "default": true, - "description": "Enables pragmas-completion plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-disable.globalOn": { - "default": true, - "description": "Enables pragmas-disable plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-suggest.globalOn": { - "default": true, - "description": "Enables pragmas-suggest plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.qualifyImportedNames.globalOn": { - "default": true, - "description": "Enables qualifyImportedNames plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.config.crossModule": { - "default": false, - "markdownDescription": "Enable experimental cross-module renaming", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.globalOn": { - "default": true, - "description": "Enables rename plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.retrie.globalOn": { - "default": true, - "description": "Enables retrie plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.semanticTokens.globalOn": { - "default": false, - "description": "Enables semanticTokens plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.splice.globalOn": { - "default": true, - "description": "Enables splice plugin", - "scope": "resource", - "type": "boolean" - } -} diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json deleted file mode 100644 index 96f2567cec..0000000000 --- a/test/testdata/schema/ghc94/default-config.golden.json +++ /dev/null @@ -1,127 +0,0 @@ -{ - "checkParents": "CheckOnSave", - "checkProject": true, - "formattingProvider": "ormolu", - "maxCompletions": 40, - "plugin": { - "alternateNumberFormat": { - "globalOn": true - }, - "cabal": { - "codeActionsOn": true, - "completionOn": true - }, - "callHierarchy": { - "globalOn": true - }, - "changeTypeSignature": { - "globalOn": true - }, - "class": { - "codeActionsOn": true, - "codeLensOn": true - }, - "eval": { - "config": { - "diff": true, - "exception": false - }, - "globalOn": true - }, - "explicit-fields": { - "globalOn": true - }, - "explicit-fixity": { - "globalOn": true - }, - "fourmolu": { - "config": { - "external": false - } - }, - "gadt": { - "globalOn": true - }, - "ghcide-code-actions-bindings": { - "globalOn": true - }, - "ghcide-code-actions-fill-holes": { - "globalOn": true - }, - "ghcide-code-actions-imports-exports": { - "globalOn": true - }, - "ghcide-code-actions-type-signatures": { - "globalOn": true - }, - "ghcide-completions": { - "config": { - "autoExtendOn": true, - "snippetsOn": true - }, - "globalOn": true - }, - "ghcide-hover-and-symbols": { - "hoverOn": true, - "symbolsOn": true - }, - "ghcide-type-lenses": { - "config": { - "mode": "always" - }, - "globalOn": true - }, - "hlint": { - "codeActionsOn": true, - "config": { - "flags": [] - }, - "diagnosticsOn": true - }, - "importLens": { - "codeActionsOn": true, - "codeLensOn": true - }, - "moduleName": { - "globalOn": true - }, - "ormolu": { - "config": { - "external": false - } - }, - "overloaded-record-dot": { - "globalOn": true - }, - "pragmas-completion": { - "globalOn": true - }, - "pragmas-disable": { - "globalOn": true - }, - "pragmas-suggest": { - "globalOn": true - }, - "qualifyImportedNames": { - "globalOn": true - }, - "rename": { - "config": { - "crossModule": false - }, - "globalOn": true - }, - "retrie": { - "globalOn": true - }, - "semanticTokens": { - "globalOn": false - }, - "splice": { - "globalOn": true - }, - "stan": { - "globalOn": false - } - } -} diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json deleted file mode 100644 index 349b07571d..0000000000 --- a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json +++ /dev/null @@ -1,270 +0,0 @@ -{ - "haskell.plugin.alternateNumberFormat.globalOn": { - "default": true, - "description": "Enables alternateNumberFormat plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.codeActionsOn": { - "default": true, - "description": "Enables cabal code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.completionOn": { - "default": true, - "description": "Enables cabal completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.callHierarchy.globalOn": { - "default": true, - "description": "Enables callHierarchy plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.changeTypeSignature.globalOn": { - "default": true, - "description": "Enables changeTypeSignature plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeActionsOn": { - "default": true, - "description": "Enables class code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeLensOn": { - "default": true, - "description": "Enables class code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.diff": { - "default": true, - "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.exception": { - "default": false, - "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.globalOn": { - "default": true, - "description": "Enables eval plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fields.globalOn": { - "default": true, - "description": "Enables explicit-fields plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fixity.globalOn": { - "default": true, - "description": "Enables explicit-fixity plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.fourmolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.gadt.globalOn": { - "default": true, - "description": "Enables gadt plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-bindings.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-bindings plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-fill-holes plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-imports-exports plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-type-signatures plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.autoExtendOn": { - "default": true, - "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.snippetsOn": { - "default": true, - "markdownDescription": "Inserts snippets when using code completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.globalOn": { - "default": true, - "description": "Enables ghcide-completions plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols hover", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols symbols", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-type-lenses.config.mode": { - "default": "always", - "description": "Control how type lenses are shown", - "enum": [ - "always", - "exported", - "diagnostics" - ], - "enumDescriptions": [ - "Always displays type lenses of global bindings", - "Only display type lenses of exported global bindings", - "Follows error messages produced by GHC about missing signatures" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.ghcide-type-lenses.globalOn": { - "default": true, - "description": "Enables ghcide-type-lenses plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.codeActionsOn": { - "default": true, - "description": "Enables hlint code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.config.flags": { - "default": [], - "markdownDescription": "Flags used by hlint", - "scope": "resource", - "type": "array" - }, - "haskell.plugin.hlint.diagnosticsOn": { - "default": true, - "description": "Enables hlint diagnostics", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeActionsOn": { - "default": true, - "description": "Enables importLens code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeLensOn": { - "default": true, - "description": "Enables importLens code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.moduleName.globalOn": { - "default": true, - "description": "Enables moduleName plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ormolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.overloaded-record-dot.globalOn": { - "default": true, - "description": "Enables overloaded-record-dot plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-completion.globalOn": { - "default": true, - "description": "Enables pragmas-completion plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-disable.globalOn": { - "default": true, - "description": "Enables pragmas-disable plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-suggest.globalOn": { - "default": true, - "description": "Enables pragmas-suggest plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.qualifyImportedNames.globalOn": { - "default": true, - "description": "Enables qualifyImportedNames plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.config.crossModule": { - "default": false, - "markdownDescription": "Enable experimental cross-module renaming", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.globalOn": { - "default": true, - "description": "Enables rename plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.retrie.globalOn": { - "default": true, - "description": "Enables retrie plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.semanticTokens.globalOn": { - "default": false, - "description": "Enables semanticTokens plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.splice.globalOn": { - "default": true, - "description": "Enables splice plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.stan.globalOn": { - "default": false, - "description": "Enables stan plugin", - "scope": "resource", - "type": "boolean" - } -} diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json index 96f2567cec..9a1ad044f3 100644 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -115,6 +115,21 @@ "globalOn": true }, "semanticTokens": { + "config": { + "tokenMapping": { + "class": "class", + "classmethod": "method", + "datacon": "enumMember", + "function": "function", + "patternsyn": "macro", + "recfield": "property", + "typecon": "enum", + "typefamily": "interface", + "typesyn": "type", + "typevariable": "typeParameter", + "variable": "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..b2cb785eb1 100644 --- a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json @@ -249,6 +249,24 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.semanticTokens.config.tokenMapping": { + "default": { + "class": "class", + "classmethod": "method", + "datacon": "enumMember", + "function": "function", + "patternsyn": "macro", + "recfield": "property", + "typecon": "enum", + "typefamily": "interface", + "typesyn": "type", + "typevariable": "typeParameter", + "variable": "variable" + }, + "markdownDescription": "Configuration of the map from hs semantic token type to LSP default token type", + "scope": "resource", + "type": "object" + }, "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 deleted file mode 100644 index 31c5a79400..0000000000 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ /dev/null @@ -1,89 +0,0 @@ -{ - "checkParents": "CheckOnSave", - "checkProject": true, - "formattingProvider": "ormolu", - "maxCompletions": 40, - "plugin": { - "alternateNumberFormat": { - "globalOn": true - }, - "cabal": { - "codeActionsOn": true, - "completionOn": true - }, - "callHierarchy": { - "globalOn": true - }, - "changeTypeSignature": { - "globalOn": true - }, - "eval": { - "config": { - "diff": true, - "exception": false - }, - "globalOn": true - }, - "explicit-fields": { - "globalOn": true - }, - "explicit-fixity": { - "globalOn": true - }, - "fourmolu": { - "config": { - "external": false - } - }, - "ghcide-completions": { - "config": { - "autoExtendOn": true, - "snippetsOn": true - }, - "globalOn": true - }, - "ghcide-hover-and-symbols": { - "hoverOn": true, - "symbolsOn": true - }, - "ghcide-type-lenses": { - "config": { - "mode": "always" - }, - "globalOn": true - }, - "importLens": { - "codeActionsOn": true, - "codeLensOn": true - }, - "moduleName": { - "globalOn": true - }, - "ormolu": { - "config": { - "external": false - } - }, - "overloaded-record-dot": { - "globalOn": true - }, - "pragmas-completion": { - "globalOn": true - }, - "pragmas-disable": { - "globalOn": true - }, - "pragmas-suggest": { - "globalOn": true - }, - "qualifyImportedNames": { - "globalOn": true - }, - "semanticTokens": { - "globalOn": false - }, - "stan": { - "globalOn": false - } - } -} diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json deleted file mode 100644 index b01b0f0189..0000000000 --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ /dev/null @@ -1,186 +0,0 @@ -{ - "haskell.plugin.alternateNumberFormat.globalOn": { - "default": true, - "description": "Enables alternateNumberFormat plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.codeActionsOn": { - "default": true, - "description": "Enables cabal code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.completionOn": { - "default": true, - "description": "Enables cabal completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.callHierarchy.globalOn": { - "default": true, - "description": "Enables callHierarchy plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.changeTypeSignature.globalOn": { - "default": true, - "description": "Enables changeTypeSignature plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.diff": { - "default": true, - "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.exception": { - "default": false, - "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.globalOn": { - "default": true, - "description": "Enables eval plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fields.globalOn": { - "default": true, - "description": "Enables explicit-fields plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fixity.globalOn": { - "default": true, - "description": "Enables explicit-fixity plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.fourmolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.autoExtendOn": { - "default": true, - "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.snippetsOn": { - "default": true, - "markdownDescription": "Inserts snippets when using code completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.globalOn": { - "default": true, - "description": "Enables ghcide-completions plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols hover", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols symbols", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-type-lenses.config.mode": { - "default": "always", - "description": "Control how type lenses are shown", - "enum": [ - "always", - "exported", - "diagnostics" - ], - "enumDescriptions": [ - "Always displays type lenses of global bindings", - "Only display type lenses of exported global bindings", - "Follows error messages produced by GHC about missing signatures" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.ghcide-type-lenses.globalOn": { - "default": true, - "description": "Enables ghcide-type-lenses plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeActionsOn": { - "default": true, - "description": "Enables importLens code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeLensOn": { - "default": true, - "description": "Enables importLens code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.moduleName.globalOn": { - "default": true, - "description": "Enables moduleName plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ormolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.overloaded-record-dot.globalOn": { - "default": true, - "description": "Enables overloaded-record-dot plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-completion.globalOn": { - "default": true, - "description": "Enables pragmas-completion plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-disable.globalOn": { - "default": true, - "description": "Enables pragmas-disable plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-suggest.globalOn": { - "default": true, - "description": "Enables pragmas-suggest plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.qualifyImportedNames.globalOn": { - "default": true, - "description": "Enables qualifyImportedNames plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.semanticTokens.globalOn": { - "default": false, - "description": "Enables semanticTokens plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.stan.globalOn": { - "default": false, - "description": "Enables stan plugin", - "scope": "resource", - "type": "boolean" - } -} From 2d3eaaa8bf9bf47f74214abd8ee5a6cf369dd97a Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 10 Jan 2024 21:59:32 +0800 Subject: [PATCH 08/24] remove typedata and add ghc98 scheme generation test file --- .../src/Ide/Plugin/SemanticTokens.hs | 3 - .../schema/ghc98/default-config.golden.json | 104 +++++++++ .../ghc98/vscode-extension-schema.golden.json | 204 ++++++++++++++++++ 3 files changed, 308 insertions(+), 3 deletions(-) create mode 100644 test/testdata/schema/ghc98/default-config.golden.json create mode 100644 test/testdata/schema/ghc98/vscode-extension-schema.golden.json 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 72388cf8d5..62b410e0d8 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeData #-} module Ide.Plugin.SemanticTokens (descriptor) where diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json new file mode 100644 index 0000000000..a64f202189 --- /dev/null +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -0,0 +1,104 @@ +{ + "checkParents": "CheckOnSave", + "checkProject": true, + "formattingProvider": "ormolu", + "maxCompletions": 40, + "plugin": { + "alternateNumberFormat": { + "globalOn": true + }, + "cabal": { + "codeActionsOn": true, + "completionOn": true + }, + "callHierarchy": { + "globalOn": true + }, + "changeTypeSignature": { + "globalOn": true + }, + "eval": { + "config": { + "diff": true, + "exception": false + }, + "globalOn": true + }, + "explicit-fields": { + "globalOn": true + }, + "explicit-fixity": { + "globalOn": true + }, + "fourmolu": { + "config": { + "external": false + } + }, + "ghcide-completions": { + "config": { + "autoExtendOn": true, + "snippetsOn": true + }, + "globalOn": true + }, + "ghcide-hover-and-symbols": { + "hoverOn": true, + "symbolsOn": true + }, + "ghcide-type-lenses": { + "config": { + "mode": "always" + }, + "globalOn": true + }, + "importLens": { + "codeActionsOn": true, + "codeLensOn": true + }, + "moduleName": { + "globalOn": true + }, + "ormolu": { + "config": { + "external": false + } + }, + "overloaded-record-dot": { + "globalOn": true + }, + "pragmas-completion": { + "globalOn": true + }, + "pragmas-disable": { + "globalOn": true + }, + "pragmas-suggest": { + "globalOn": true + }, + "qualifyImportedNames": { + "globalOn": true + }, + "semanticTokens": { + "config": { + "tokenMapping": { + "class": "class", + "classmethod": "method", + "datacon": "enumMember", + "function": "function", + "patternsyn": "macro", + "recfield": "property", + "typecon": "enum", + "typefamily": "interface", + "typesyn": "type", + "typevariable": "typeParameter", + "variable": "variable" + } + }, + "globalOn": false + }, + "stan": { + "globalOn": false + } + } +} diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json new file mode 100644 index 0000000000..340658683e --- /dev/null +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -0,0 +1,204 @@ +{ + "haskell.plugin.alternateNumberFormat.globalOn": { + "default": true, + "description": "Enables alternateNumberFormat plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.codeActionsOn": { + "default": true, + "description": "Enables cabal code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.completionOn": { + "default": true, + "description": "Enables cabal completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.callHierarchy.globalOn": { + "default": true, + "description": "Enables callHierarchy plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.changeTypeSignature.globalOn": { + "default": true, + "description": "Enables changeTypeSignature plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.diff": { + "default": true, + "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.exception": { + "default": false, + "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.globalOn": { + "default": true, + "description": "Enables eval plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fields.globalOn": { + "default": true, + "description": "Enables explicit-fields plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fixity.globalOn": { + "default": true, + "description": "Enables explicit-fixity plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.fourmolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.autoExtendOn": { + "default": true, + "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.snippetsOn": { + "default": true, + "markdownDescription": "Inserts snippets when using code completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.globalOn": { + "default": true, + "description": "Enables ghcide-completions plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols hover", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols symbols", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-type-lenses.config.mode": { + "default": "always", + "description": "Control how type lenses are shown", + "enum": [ + "always", + "exported", + "diagnostics" + ], + "enumDescriptions": [ + "Always displays type lenses of global bindings", + "Only display type lenses of exported global bindings", + "Follows error messages produced by GHC about missing signatures" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.ghcide-type-lenses.globalOn": { + "default": true, + "description": "Enables ghcide-type-lenses plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeActionsOn": { + "default": true, + "description": "Enables importLens code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeLensOn": { + "default": true, + "description": "Enables importLens code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.moduleName.globalOn": { + "default": true, + "description": "Enables moduleName plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ormolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.overloaded-record-dot.globalOn": { + "default": true, + "description": "Enables overloaded-record-dot plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-completion.globalOn": { + "default": true, + "description": "Enables pragmas-completion plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-disable.globalOn": { + "default": true, + "description": "Enables pragmas-disable plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-suggest.globalOn": { + "default": true, + "description": "Enables pragmas-suggest plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.qualifyImportedNames.globalOn": { + "default": true, + "description": "Enables qualifyImportedNames plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.semanticTokens.config.tokenMapping": { + "default": { + "class": "class", + "classmethod": "method", + "datacon": "enumMember", + "function": "function", + "patternsyn": "macro", + "recfield": "property", + "typecon": "enum", + "typefamily": "interface", + "typesyn": "type", + "typevariable": "typeParameter", + "variable": "variable" + }, + "markdownDescription": "Configuration of the map from hs semantic token type to LSP default token type", + "scope": "resource", + "type": "object" + }, + "haskell.plugin.semanticTokens.globalOn": { + "default": false, + "description": "Enables semanticTokens plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.stan.globalOn": { + "default": false, + "description": "Enables stan plugin", + "scope": "resource", + "type": "boolean" + } +} From 04fe4accfb21d628968f60798092f829da19fe52 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 10 Jan 2024 22:17:58 +0800 Subject: [PATCH 09/24] Ajust case in mappings --- .../src/Ide/Plugin/SemanticTokens/Types.hs | 5 ++++- plugins/hls-semantic-tokens-plugin/test/Main.hs | 9 --------- .../schema/ghc96/default-config.golden.json | 16 ++++++++-------- .../ghc96/vscode-extension-schema.golden.json | 16 ++++++++-------- .../schema/ghc98/default-config.golden.json | 16 ++++++++-------- .../ghc98/vscode-extension-schema.golden.json | 16 ++++++++-------- 6 files changed, 36 insertions(+), 42 deletions(-) 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 bd3b2e6e7a..e3d5e7c77f 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 @@ -100,8 +100,11 @@ $(Rank2.TH.deriveAll ''SemanticTokensConfig_) withDef :: SemanticTokensConfig -> SemanticTokensConfig_ Maybe -> SemanticTokensConfig withDef = Rank2.liftA2 (\x y -> Identity (fromMaybe (runIdentity x) y)) instance FromJSON SemanticTokensConfig where parseJSON = fmap (withDef def) . parseJSON +lowerFirst :: String -> String +lowerFirst [] = [] +lowerFirst (x:xs) = toLower x : xs stOption :: Options -stOption = defaultOptions { fieldLabelModifier = map toLower . drop 2 } +stOption = defaultOptions { fieldLabelModifier = lowerFirst . drop 2 } instance FromJSON (SemanticTokensConfig_ Maybe) where parseJSON = genericParseJSON stOption instance ToJSON (SemanticTokensConfig_ Maybe) where toJSON = genericToJSON stOption instance ToJSON SemanticTokensConfig where toJSON = genericToJSON stOption diff --git a/plugins/hls-semantic-tokens-plugin/test/Main.hs b/plugins/hls-semantic-tokens-plugin/test/Main.hs index 0aafccc966..3c4779abd4 100644 --- a/plugins/hls-semantic-tokens-plugin/test/Main.hs +++ b/plugins/hls-semantic-tokens-plugin/test/Main.hs @@ -24,7 +24,6 @@ import Ide.Plugin.SemanticTokens.Mappings import Ide.Plugin.SemanticTokens.Types import Ide.Types import Language.LSP.Protocol.Types (SemanticTokenTypes (..), - SemanticTokensParams (..), _L) import Language.LSP.Test (Session (..), SessionConfig (ignoreConfigurationRequests), @@ -98,19 +97,11 @@ docLspSemanticTokensString doc = do res <- Test.getSemanticTokens doc textContent <- documentContents doc let vfs = VirtualFile 0 0 (Rope.fromText textContent) - let expect = [] case res ^? Language.LSP.Protocol.Types._L of Just tokens -> do 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 diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json index 9a1ad044f3..39ce29c0cc 100644 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -118,15 +118,15 @@ "config": { "tokenMapping": { "class": "class", - "classmethod": "method", - "datacon": "enumMember", + "classMethod": "method", + "dataCon": "enumMember", "function": "function", - "patternsyn": "macro", - "recfield": "property", - "typecon": "enum", - "typefamily": "interface", - "typesyn": "type", - "typevariable": "typeParameter", + "patternSyn": "macro", + "recField": "property", + "typeCon": "enum", + "typeFamily": "interface", + "typeSyn": "type", + "typeVariable": "typeParameter", "variable": "variable" } }, diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json index b2cb785eb1..2a13be8252 100644 --- a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json @@ -252,15 +252,15 @@ "haskell.plugin.semanticTokens.config.tokenMapping": { "default": { "class": "class", - "classmethod": "method", - "datacon": "enumMember", + "classMethod": "method", + "dataCon": "enumMember", "function": "function", - "patternsyn": "macro", - "recfield": "property", - "typecon": "enum", - "typefamily": "interface", - "typesyn": "type", - "typevariable": "typeParameter", + "patternSyn": "macro", + "recField": "property", + "typeCon": "enum", + "typeFamily": "interface", + "typeSyn": "type", + "typeVariable": "typeParameter", "variable": "variable" }, "markdownDescription": "Configuration of the map from hs semantic token type to LSP default token type", diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json index a64f202189..eac9653f62 100644 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -83,15 +83,15 @@ "config": { "tokenMapping": { "class": "class", - "classmethod": "method", - "datacon": "enumMember", + "classMethod": "method", + "dataCon": "enumMember", "function": "function", - "patternsyn": "macro", - "recfield": "property", - "typecon": "enum", - "typefamily": "interface", - "typesyn": "type", - "typevariable": "typeParameter", + "patternSyn": "macro", + "recField": "property", + "typeCon": "enum", + "typeFamily": "interface", + "typeSyn": "type", + "typeVariable": "typeParameter", "variable": "variable" } }, diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json index 340658683e..8c4ddaceab 100644 --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -174,15 +174,15 @@ "haskell.plugin.semanticTokens.config.tokenMapping": { "default": { "class": "class", - "classmethod": "method", - "datacon": "enumMember", + "classMethod": "method", + "dataCon": "enumMember", "function": "function", - "patternsyn": "macro", - "recfield": "property", - "typecon": "enum", - "typefamily": "interface", - "typesyn": "type", - "typevariable": "typeParameter", + "patternSyn": "macro", + "recField": "property", + "typeCon": "enum", + "typeFamily": "interface", + "typeSyn": "type", + "typeVariable": "typeParameter", "variable": "variable" }, "markdownDescription": "Configuration of the map from hs semantic token type to LSP default token type", From fc1b95e2f27c9fdb8ffbaa8058d6f978497c838d Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 10 Jan 2024 22:20:32 +0800 Subject: [PATCH 10/24] add ghc92 generate scheme --- .../schema/ghc92/default-config.golden.json | 139 +++++++++ .../ghc92/vscode-extension-schema.golden.json | 282 ++++++++++++++++++ 2 files changed, 421 insertions(+) create mode 100644 test/testdata/schema/ghc92/default-config.golden.json create mode 100644 test/testdata/schema/ghc92/vscode-extension-schema.golden.json diff --git a/test/testdata/schema/ghc92/default-config.golden.json b/test/testdata/schema/ghc92/default-config.golden.json new file mode 100644 index 0000000000..140214aacc --- /dev/null +++ b/test/testdata/schema/ghc92/default-config.golden.json @@ -0,0 +1,139 @@ +{ + "checkParents": "CheckOnSave", + "checkProject": true, + "formattingProvider": "ormolu", + "maxCompletions": 40, + "plugin": { + "alternateNumberFormat": { + "globalOn": true + }, + "cabal": { + "codeActionsOn": true, + "completionOn": true + }, + "callHierarchy": { + "globalOn": true + }, + "changeTypeSignature": { + "globalOn": true + }, + "class": { + "codeActionsOn": true, + "codeLensOn": true + }, + "eval": { + "config": { + "diff": true, + "exception": false + }, + "globalOn": true + }, + "explicit-fields": { + "globalOn": true + }, + "explicit-fixity": { + "globalOn": true + }, + "fourmolu": { + "config": { + "external": false + } + }, + "gadt": { + "globalOn": true + }, + "ghcide-code-actions-bindings": { + "globalOn": true + }, + "ghcide-code-actions-fill-holes": { + "globalOn": true + }, + "ghcide-code-actions-imports-exports": { + "globalOn": true + }, + "ghcide-code-actions-type-signatures": { + "globalOn": true + }, + "ghcide-completions": { + "config": { + "autoExtendOn": true, + "snippetsOn": true + }, + "globalOn": true + }, + "ghcide-hover-and-symbols": { + "hoverOn": true, + "symbolsOn": true + }, + "ghcide-type-lenses": { + "config": { + "mode": "always" + }, + "globalOn": true + }, + "hlint": { + "codeActionsOn": true, + "config": { + "flags": [] + }, + "diagnosticsOn": true + }, + "importLens": { + "codeActionsOn": true, + "codeLensOn": true + }, + "moduleName": { + "globalOn": true + }, + "ormolu": { + "config": { + "external": false + } + }, + "overloaded-record-dot": { + "globalOn": true + }, + "pragmas-completion": { + "globalOn": true + }, + "pragmas-disable": { + "globalOn": true + }, + "pragmas-suggest": { + "globalOn": true + }, + "qualifyImportedNames": { + "globalOn": true + }, + "rename": { + "config": { + "crossModule": false + }, + "globalOn": true + }, + "retrie": { + "globalOn": true + }, + "semanticTokens": { + "config": { + "tokenMapping": { + "class": "class", + "classMethod": "method", + "dataCon": "enumMember", + "function": "function", + "patternSyn": "macro", + "recField": "property", + "typeCon": "enum", + "typeFamily": "interface", + "typeSyn": "type", + "typeVariable": "typeParameter", + "variable": "variable" + } + }, + "globalOn": false + }, + "splice": { + "globalOn": true + } + } +} diff --git a/test/testdata/schema/ghc92/vscode-extension-schema.golden.json b/test/testdata/schema/ghc92/vscode-extension-schema.golden.json new file mode 100644 index 0000000000..6f408bbd36 --- /dev/null +++ b/test/testdata/schema/ghc92/vscode-extension-schema.golden.json @@ -0,0 +1,282 @@ +{ + "haskell.plugin.alternateNumberFormat.globalOn": { + "default": true, + "description": "Enables alternateNumberFormat plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.codeActionsOn": { + "default": true, + "description": "Enables cabal code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.completionOn": { + "default": true, + "description": "Enables cabal completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.callHierarchy.globalOn": { + "default": true, + "description": "Enables callHierarchy plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.changeTypeSignature.globalOn": { + "default": true, + "description": "Enables changeTypeSignature plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.class.codeActionsOn": { + "default": true, + "description": "Enables class code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.class.codeLensOn": { + "default": true, + "description": "Enables class code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.diff": { + "default": true, + "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.exception": { + "default": false, + "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.globalOn": { + "default": true, + "description": "Enables eval plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fields.globalOn": { + "default": true, + "description": "Enables explicit-fields plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fixity.globalOn": { + "default": true, + "description": "Enables explicit-fixity plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.fourmolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.gadt.globalOn": { + "default": true, + "description": "Enables gadt plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-bindings.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-bindings plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-fill-holes plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-imports-exports plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-type-signatures plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.autoExtendOn": { + "default": true, + "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.snippetsOn": { + "default": true, + "markdownDescription": "Inserts snippets when using code completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.globalOn": { + "default": true, + "description": "Enables ghcide-completions plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols hover", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols symbols", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-type-lenses.config.mode": { + "default": "always", + "description": "Control how type lenses are shown", + "enum": [ + "always", + "exported", + "diagnostics" + ], + "enumDescriptions": [ + "Always displays type lenses of global bindings", + "Only display type lenses of exported global bindings", + "Follows error messages produced by GHC about missing signatures" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.ghcide-type-lenses.globalOn": { + "default": true, + "description": "Enables ghcide-type-lenses plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.codeActionsOn": { + "default": true, + "description": "Enables hlint code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.config.flags": { + "default": [], + "markdownDescription": "Flags used by hlint", + "scope": "resource", + "type": "array" + }, + "haskell.plugin.hlint.diagnosticsOn": { + "default": true, + "description": "Enables hlint diagnostics", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeActionsOn": { + "default": true, + "description": "Enables importLens code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeLensOn": { + "default": true, + "description": "Enables importLens code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.moduleName.globalOn": { + "default": true, + "description": "Enables moduleName plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ormolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.overloaded-record-dot.globalOn": { + "default": true, + "description": "Enables overloaded-record-dot plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-completion.globalOn": { + "default": true, + "description": "Enables pragmas-completion plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-disable.globalOn": { + "default": true, + "description": "Enables pragmas-disable plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-suggest.globalOn": { + "default": true, + "description": "Enables pragmas-suggest plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.qualifyImportedNames.globalOn": { + "default": true, + "description": "Enables qualifyImportedNames plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.rename.config.crossModule": { + "default": false, + "markdownDescription": "Enable experimental cross-module renaming", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.rename.globalOn": { + "default": true, + "description": "Enables rename plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.retrie.globalOn": { + "default": true, + "description": "Enables retrie plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.semanticTokens.config.tokenMapping": { + "default": { + "class": "class", + "classMethod": "method", + "dataCon": "enumMember", + "function": "function", + "patternSyn": "macro", + "recField": "property", + "typeCon": "enum", + "typeFamily": "interface", + "typeSyn": "type", + "typeVariable": "typeParameter", + "variable": "variable" + }, + "markdownDescription": "Configuration of the map from hs semantic token type to LSP default token type", + "scope": "resource", + "type": "object" + }, + "haskell.plugin.semanticTokens.globalOn": { + "default": false, + "description": "Enables semanticTokens plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.splice.globalOn": { + "default": true, + "description": "Enables splice plugin", + "scope": "resource", + "type": "boolean" + } +} From 95a9857529be924e26476cbf334b0664995eee76 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 10 Jan 2024 22:31:49 +0800 Subject: [PATCH 11/24] add ghc94 generate scheme --- .../schema/ghc94/default-config.golden.json | 142 +++++++++ .../ghc94/vscode-extension-schema.golden.json | 288 ++++++++++++++++++ 2 files changed, 430 insertions(+) create mode 100644 test/testdata/schema/ghc94/default-config.golden.json create mode 100644 test/testdata/schema/ghc94/vscode-extension-schema.golden.json diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json new file mode 100644 index 0000000000..39ce29c0cc --- /dev/null +++ b/test/testdata/schema/ghc94/default-config.golden.json @@ -0,0 +1,142 @@ +{ + "checkParents": "CheckOnSave", + "checkProject": true, + "formattingProvider": "ormolu", + "maxCompletions": 40, + "plugin": { + "alternateNumberFormat": { + "globalOn": true + }, + "cabal": { + "codeActionsOn": true, + "completionOn": true + }, + "callHierarchy": { + "globalOn": true + }, + "changeTypeSignature": { + "globalOn": true + }, + "class": { + "codeActionsOn": true, + "codeLensOn": true + }, + "eval": { + "config": { + "diff": true, + "exception": false + }, + "globalOn": true + }, + "explicit-fields": { + "globalOn": true + }, + "explicit-fixity": { + "globalOn": true + }, + "fourmolu": { + "config": { + "external": false + } + }, + "gadt": { + "globalOn": true + }, + "ghcide-code-actions-bindings": { + "globalOn": true + }, + "ghcide-code-actions-fill-holes": { + "globalOn": true + }, + "ghcide-code-actions-imports-exports": { + "globalOn": true + }, + "ghcide-code-actions-type-signatures": { + "globalOn": true + }, + "ghcide-completions": { + "config": { + "autoExtendOn": true, + "snippetsOn": true + }, + "globalOn": true + }, + "ghcide-hover-and-symbols": { + "hoverOn": true, + "symbolsOn": true + }, + "ghcide-type-lenses": { + "config": { + "mode": "always" + }, + "globalOn": true + }, + "hlint": { + "codeActionsOn": true, + "config": { + "flags": [] + }, + "diagnosticsOn": true + }, + "importLens": { + "codeActionsOn": true, + "codeLensOn": true + }, + "moduleName": { + "globalOn": true + }, + "ormolu": { + "config": { + "external": false + } + }, + "overloaded-record-dot": { + "globalOn": true + }, + "pragmas-completion": { + "globalOn": true + }, + "pragmas-disable": { + "globalOn": true + }, + "pragmas-suggest": { + "globalOn": true + }, + "qualifyImportedNames": { + "globalOn": true + }, + "rename": { + "config": { + "crossModule": false + }, + "globalOn": true + }, + "retrie": { + "globalOn": true + }, + "semanticTokens": { + "config": { + "tokenMapping": { + "class": "class", + "classMethod": "method", + "dataCon": "enumMember", + "function": "function", + "patternSyn": "macro", + "recField": "property", + "typeCon": "enum", + "typeFamily": "interface", + "typeSyn": "type", + "typeVariable": "typeParameter", + "variable": "variable" + } + }, + "globalOn": false + }, + "splice": { + "globalOn": true + }, + "stan": { + "globalOn": false + } + } +} diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json new file mode 100644 index 0000000000..2a13be8252 --- /dev/null +++ b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json @@ -0,0 +1,288 @@ +{ + "haskell.plugin.alternateNumberFormat.globalOn": { + "default": true, + "description": "Enables alternateNumberFormat plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.codeActionsOn": { + "default": true, + "description": "Enables cabal code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.completionOn": { + "default": true, + "description": "Enables cabal completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.callHierarchy.globalOn": { + "default": true, + "description": "Enables callHierarchy plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.changeTypeSignature.globalOn": { + "default": true, + "description": "Enables changeTypeSignature plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.class.codeActionsOn": { + "default": true, + "description": "Enables class code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.class.codeLensOn": { + "default": true, + "description": "Enables class code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.diff": { + "default": true, + "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.exception": { + "default": false, + "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.globalOn": { + "default": true, + "description": "Enables eval plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fields.globalOn": { + "default": true, + "description": "Enables explicit-fields plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fixity.globalOn": { + "default": true, + "description": "Enables explicit-fixity plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.fourmolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.gadt.globalOn": { + "default": true, + "description": "Enables gadt plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-bindings.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-bindings plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-fill-holes plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-imports-exports plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-type-signatures plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.autoExtendOn": { + "default": true, + "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.snippetsOn": { + "default": true, + "markdownDescription": "Inserts snippets when using code completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.globalOn": { + "default": true, + "description": "Enables ghcide-completions plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols hover", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols symbols", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-type-lenses.config.mode": { + "default": "always", + "description": "Control how type lenses are shown", + "enum": [ + "always", + "exported", + "diagnostics" + ], + "enumDescriptions": [ + "Always displays type lenses of global bindings", + "Only display type lenses of exported global bindings", + "Follows error messages produced by GHC about missing signatures" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.ghcide-type-lenses.globalOn": { + "default": true, + "description": "Enables ghcide-type-lenses plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.codeActionsOn": { + "default": true, + "description": "Enables hlint code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.config.flags": { + "default": [], + "markdownDescription": "Flags used by hlint", + "scope": "resource", + "type": "array" + }, + "haskell.plugin.hlint.diagnosticsOn": { + "default": true, + "description": "Enables hlint diagnostics", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeActionsOn": { + "default": true, + "description": "Enables importLens code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeLensOn": { + "default": true, + "description": "Enables importLens code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.moduleName.globalOn": { + "default": true, + "description": "Enables moduleName plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ormolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.overloaded-record-dot.globalOn": { + "default": true, + "description": "Enables overloaded-record-dot plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-completion.globalOn": { + "default": true, + "description": "Enables pragmas-completion plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-disable.globalOn": { + "default": true, + "description": "Enables pragmas-disable plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-suggest.globalOn": { + "default": true, + "description": "Enables pragmas-suggest plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.qualifyImportedNames.globalOn": { + "default": true, + "description": "Enables qualifyImportedNames plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.rename.config.crossModule": { + "default": false, + "markdownDescription": "Enable experimental cross-module renaming", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.rename.globalOn": { + "default": true, + "description": "Enables rename plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.retrie.globalOn": { + "default": true, + "description": "Enables retrie plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.semanticTokens.config.tokenMapping": { + "default": { + "class": "class", + "classMethod": "method", + "dataCon": "enumMember", + "function": "function", + "patternSyn": "macro", + "recField": "property", + "typeCon": "enum", + "typeFamily": "interface", + "typeSyn": "type", + "typeVariable": "typeParameter", + "variable": "variable" + }, + "markdownDescription": "Configuration of the map from hs semantic token type to LSP default token type", + "scope": "resource", + "type": "object" + }, + "haskell.plugin.semanticTokens.globalOn": { + "default": false, + "description": "Enables semanticTokens plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.splice.globalOn": { + "default": true, + "description": "Enables splice plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.stan.globalOn": { + "default": false, + "description": "Enables stan plugin", + "scope": "resource", + "type": "boolean" + } +} From c80e9fc993fe6d51d2b9859016540f6484baac5a Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 10 Jan 2024 22:34:22 +0800 Subject: [PATCH 12/24] cleanup --- .../src/Ide/Plugin/SemanticTokens/Types.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) 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 e3d5e7c77f..b69eb8cc57 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,19 +1,18 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} module Ide.Plugin.SemanticTokens.Types where From 6acd8a31ed09f5d0681398ef5366f98a98647e4c Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 11 Jan 2024 22:16:17 +0800 Subject: [PATCH 13/24] modify the lspTokenReverseMap to take semantic config --- .../src/Ide/Plugin/SemanticTokens/Mappings.hs | 31 ++++++----- .../hls-semantic-tokens-plugin/test/Main.hs | 54 +++++++++---------- 2 files changed, 45 insertions(+), 40 deletions(-) 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 a31ba4d78c..de7182836d 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 @@ -48,11 +48,15 @@ toLspTokenType conf tk = case tk of TRecField -> runIdentity $ stRecField conf TPatternSyn -> runIdentity $ stPatternSyn conf -lspTokenReverseMap :: Map.Map SemanticTokenTypes HsSemanticTokenType -lspTokenReverseMap = Map.fromList $ map (\x -> (toLspTokenType def x, x)) $ enumFrom minBound +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 -fromLspTokenType :: SemanticTokenTypes -> Maybe HsSemanticTokenType -fromLspTokenType tk = Map.lookup tk lspTokenReverseMap +fromLspTokenType :: SemanticTokensConfig -> SemanticTokenTypes -> Maybe HsSemanticTokenType +fromLspTokenType cf tk = Map.lookup tk (lspTokenReverseMap cf) -- * 2. Mapping from GHC type and tyThing to semantic token type. @@ -156,18 +160,19 @@ infoTokenType x = case x of -- 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) --- this use the default token type mapping -recoverSemanticTokens :: VirtualFile -> SemanticTokens -> Either Text [SemanticTokenOriginal HsSemanticTokenType] -recoverSemanticTokens v s = 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 fromLspTokenTypeStrict tks + return $ map (lspTokenHsToken config) tks --- | fromLspTokenTypeStrict +-- | lspTokenHsToken -- for debug and test. --- use the default token type mapping to convert lsp token type to haskell token type -fromLspTokenTypeStrict :: SemanticTokenOriginal SemanticTokenTypes -> SemanticTokenOriginal HsSemanticTokenType -fromLspTokenTypeStrict (SemanticTokenOriginal tokenType location name) = - case fromLspTokenType tokenType of +-- 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 fromLspTokenType config tokenType of Just t -> SemanticTokenOriginal t location name Nothing -> error "recoverSemanticTokens: unknown lsp token type" diff --git a/plugins/hls-semantic-tokens-plugin/test/Main.hs b/plugins/hls-semantic-tokens-plugin/test/Main.hs index 3c4779abd4..03838690f5 100644 --- a/plugins/hls-semantic-tokens-plugin/test/Main.hs +++ b/plugins/hls-semantic-tokens-plugin/test/Main.hs @@ -76,8 +76,8 @@ goldenWithHaskellAndCapsOutPut config plugin title tree path desc act = void waitForBuildQueue act doc -goldenWithSemanticTokens :: TestName -> FilePath -> TestTree -goldenWithSemanticTokens title path = +goldenWithSemanticTokensWithDefaultConfig :: TestName -> FilePath -> TestTree +goldenWithSemanticTokensWithDefaultConfig title path = goldenWithHaskellAndCapsOutPut def semanticTokensPlugin @@ -85,11 +85,11 @@ goldenWithSemanticTokens title path = (mkFs $ FS.directProject (path <.> "hs")) path "expected" - docSemanticTokensString + (docSemanticTokensString def) -docSemanticTokensString :: TextDocumentIdentifier -> Session String -docSemanticTokensString doc = do - xs <- map fromLspTokenTypeStrict <$> docLspSemanticTokensString doc +docSemanticTokensString :: SemanticTokensConfig-> TextDocumentIdentifier -> Session String +docSemanticTokensString cf doc = do + xs <- map (lspTokenHsToken cf) <$> docLspSemanticTokensString doc return $ unlines . map show $ xs docLspSemanticTokensString :: TextDocumentIdentifier -> Session [SemanticTokenOriginal Language.LSP.Protocol.Types.SemanticTokenTypes] @@ -106,19 +106,19 @@ 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 @@ -187,35 +187,35 @@ semanticTokensTests = 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" "TPatternSyn", + goldenWithSemanticTokensWithDefaultConfig "type family" "TTypefamily", + goldenWithSemanticTokensWithDefaultConfig "TUnicodeSyntax" "TUnicodeSyntax" ] semanticTokensDataTypeTests :: TestTree semanticTokensDataTypeTests = testGroup "get semantic Tokens" - [ goldenWithSemanticTokens "simple datatype" "TDataType", - goldenWithSemanticTokens "record" "TRecord", - goldenWithSemanticTokens "datatype import" "TDatatypeImported", - goldenWithSemanticTokens "datatype family" "TDataFamily", - goldenWithSemanticTokens "GADT" "TGADT" + [ goldenWithSemanticTokensWithDefaultConfig "simple datatype" "TDataType", + goldenWithSemanticTokensWithDefaultConfig "record" "TRecord", + 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 () From 558c323c10b46f79cb5d26128f62a3a432972f95 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 11 Jan 2024 22:17:11 +0800 Subject: [PATCH 14/24] rename fromLspTokenType to lspTokenTypeHsTokenType --- .../src/Ide/Plugin/SemanticTokens/Mappings.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) 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 de7182836d..5610137fe8 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 @@ -55,8 +55,8 @@ lspTokenReverseMap config where xs = enumFrom minBound mr = Map.fromList $ map (\x -> (toLspTokenType config x, x)) xs -fromLspTokenType :: SemanticTokensConfig -> SemanticTokenTypes -> Maybe HsSemanticTokenType -fromLspTokenType cf tk = Map.lookup tk (lspTokenReverseMap cf) +lspTokenTypeHsTokenType :: SemanticTokensConfig -> SemanticTokenTypes -> Maybe HsSemanticTokenType +lspTokenTypeHsTokenType cf tk = Map.lookup tk (lspTokenReverseMap cf) -- * 2. Mapping from GHC type and tyThing to semantic token type. @@ -172,7 +172,7 @@ recoverSemanticTokens config v s = do -- the `SemanticTokensConfig` used should be a map with bijection property lspTokenHsToken :: SemanticTokensConfig -> SemanticTokenOriginal SemanticTokenTypes -> SemanticTokenOriginal HsSemanticTokenType lspTokenHsToken config (SemanticTokenOriginal tokenType location name) = - case fromLspTokenType config tokenType of + case lspTokenTypeHsTokenType config tokenType of Just t -> SemanticTokenOriginal t location name Nothing -> error "recoverSemanticTokens: unknown lsp token type" From dab0a2b3927121474bc0b157f7cdd5061a5a2d65 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 12 Jan 2024 04:57:42 +0800 Subject: [PATCH 15/24] add description for semantic tokens mappings config --- .../hls-semantic-tokens-plugin.cabal | 5 +- .../src/Ide/Plugin/SemanticTokens.hs | 3 +- .../src/Ide/Plugin/SemanticTokens/Internal.hs | 92 ++++++++------- .../src/Ide/Plugin/SemanticTokens/Mappings.hs | 26 ++--- .../Plugin/SemanticTokens/SemanticConfig.hs | 87 ++++++++++++++ .../src/Ide/Plugin/SemanticTokens/Types.hs | 109 +++++++----------- .../hls-semantic-tokens-plugin/test/Main.hs | 2 +- stack-lts21.yaml | 2 - stack.yaml | 2 - 9 files changed, 195 insertions(+), 133 deletions(-) create mode 100644 plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs 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 bc825e75be..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,8 +53,8 @@ library , array , deepseq , hls-graph == 2.5.0.0 + , template-haskell , data-default - , rank2classes default-language: Haskell2010 default-extensions: DataKinds @@ -86,5 +87,5 @@ test-suite tests , bytestring , ghcide == 2.5.0.0 , hls-plugin-api == 2.5.0.0 - , rank2classes + , 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 62b410e0d8..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 @@ -16,6 +17,6 @@ descriptor recorder plId = pluginConfigDescriptor = defaultConfigDescriptor { configInitialGenericConfig = (configInitialGenericConfig defaultConfigDescriptor) {plcGlobalOn = False} - , configCustomConfig = mkCustomConfig semanticConfigProperties + , 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 4a82b85d5b..e86ef03cfa 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,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} @@ -7,67 +8,72 @@ {-# 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.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 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, + SemanticTokenTypes, + SemanticTokens, + type (|?) (InL)) +import Prelude hiding (span) +$mkSemanticConfigFunctions + ----------------------- ---- the api ----------------------- computeSemanticTokens :: Recorder (WithPriority SemanticLog) -> PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError Action SemanticTokens computeSemanticTokens recorder pid _ nfp = do - logWith recorder Debug (LogMsg "computeSemanticTokens start") - config :: SemanticTokensConfig <- lift $ usePropertyAction #tokenMapping pid semanticConfigProperties - logWith recorder Debug (LogMsg $ show $ toJSON config) + config <- lift $ useSemanticConfigAction pid logWith recorder Debug (LogConfig config) (RangeHsSemanticTokenTypes {rangeSemanticMap}, mapping) <- useWithStaleE GetSemanticTokens nfp withExceptT PluginInternalError $ liftEither $ rangeSemanticMapSemanticTokens config mapping rangeSemanticMap 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 5610137fe8..6ed46a1bee 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 @@ -2,6 +2,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} + + -- | -- This module provides mappings to convert token type information in the Haskell IDE plugin. It includes functions for: -- @@ -12,8 +14,6 @@ module Ide.Plugin.SemanticTokens.Mappings where import qualified Data.Array as A -import Data.Default (def) -import Data.Functor.Identity (Identity (runIdentity)) import Data.List.Extra (chunksOf, (!?)) import qualified Data.Map as Map import Data.Maybe (mapMaybe) @@ -36,17 +36,17 @@ import Language.LSP.VFS hiding (line) -- | map from haskell semantic token type to LSP default token type toLspTokenType :: SemanticTokensConfig -> HsSemanticTokenType -> SemanticTokenTypes toLspTokenType conf tk = case tk of - TFunction -> runIdentity $ stFunction conf - TVariable -> runIdentity $ stVariable conf - TClassMethod -> runIdentity $ stClassMethod conf - TTypeVariable -> runIdentity $ stTypeVariable conf - TDataCon -> runIdentity $ stDataCon conf - TClass -> runIdentity $ stClass conf - TTypeCon -> runIdentity $ stTypeCon conf - TTypeSyn -> runIdentity $ stTypeSyn conf - TTypeFamily -> runIdentity $ stTypeFamily conf - TRecField -> runIdentity $ stRecField conf - TPatternSyn -> runIdentity $ stPatternSyn conf + TFunction -> stFunction conf + TVariable -> stVariable conf + TClassMethod -> stClassMethod conf + TTypeVariable -> stTypeVariable conf + TDataCon -> stDataCon conf + TClass -> stClass conf + TTypeCon -> stTypeCon conf + TTypeSyn -> stTypeSyn conf + TTypeFamily -> stTypeFamily conf + TRecField -> stRecField conf + TPatternSyn -> stPatternSyn conf lspTokenReverseMap :: SemanticTokensConfig -> Map.Map SemanticTokenTypes HsSemanticTokenType lspTokenReverseMap config 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..9701908f86 --- /dev/null +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Ide.Plugin.SemanticTokens.SemanticConfig where + +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) + +toConfigName :: String -> String +toConfigName = ("st" <>) + +-- lspTokenTypeDescription :: [(SemanticTokenTypes, String)] +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 + +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 :: SemanticConfigProperties +-- 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 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 " <> T.pack (drop 1 $ show 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 b69eb8cc57..80b95a11ae 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 @@ -3,45 +3,37 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE ImportQualifiedPost #-} + {-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE OverloadedLabels #-} + {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} + + {-# LANGUAGE StrictData #-} -{-# LANGUAGE TemplateHaskell #-} + {-# LANGUAGE TypeFamilies #-} + +{-# LANGUAGE DeriveLift #-} +{-# LANGUAGE ScopedTypeVariables #-} + module Ide.Plugin.SemanticTokens.Types where import Control.DeepSeq (NFData (rnf), rwhnf) -import Control.Monad.Identity (Identity (..)) -import Data.Aeson (FromJSON (parseJSON), - Options (..), ToJSON, - defaultOptions, - genericParseJSON, genericToJSON) -import Data.Aeson.Types (ToJSON (toJSON)) import qualified Data.Array as A -import Data.Char (toLower) import Data.Default (Default (def)) import Data.Generics (Typeable) import qualified Data.Map as M -import Data.Maybe (fromMaybe) import Development.IDE (Pretty (pretty), RuleResult) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat hiding (loc) import Development.IDE.Graph.Classes (Hashable) import GHC.Generics (Generic) -import Ide.Plugin.Properties (Properties, - PropertyKey (PropertyKey), - PropertyType (TObject), - defineObjectProperty, - emptyProperties, (&)) import Language.LSP.Protocol.Types -import qualified Rank2 -import qualified Rank2.TH +-- 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 @@ -58,64 +50,43 @@ data HsSemanticTokenType | TTypeSyn -- Type synonym | TTypeFamily -- type family | TRecField -- from match bind - deriving (Eq, Ord, Show, Enum, Bounded) + deriving (Eq, Ord, Show, Enum, Bounded, Generic, Lift) -type SemanticTokensConfig = SemanticTokensConfig_ Identity +-- type SemanticTokensConfig = SemanticTokensConfig_ Identity instance Default SemanticTokensConfig where def = STC - { stFunction = Identity SemanticTokenTypes_Function - , stVariable = Identity SemanticTokenTypes_Variable - , stDataCon = Identity SemanticTokenTypes_EnumMember - , stTypeVariable = Identity SemanticTokenTypes_TypeParameter - , stClassMethod = Identity SemanticTokenTypes_Method + { stFunction = SemanticTokenTypes_Function + , stVariable = SemanticTokenTypes_Variable + , stDataCon = SemanticTokenTypes_EnumMember + , stTypeVariable = SemanticTokenTypes_TypeParameter + , stClassMethod = SemanticTokenTypes_Method -- pattern syn is like a limited version of macro of constructing a term - , stPatternSyn = Identity SemanticTokenTypes_Macro + , stPatternSyn = 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 - , stTypeCon = Identity SemanticTokenTypes_Enum - , stClass = Identity SemanticTokenTypes_Class - , stTypeSyn = Identity SemanticTokenTypes_Type - , stTypeFamily = Identity SemanticTokenTypes_Interface - , stRecField = Identity SemanticTokenTypes_Property + , stTypeCon = SemanticTokenTypes_Enum + , stClass = SemanticTokenTypes_Class + , stTypeSyn = SemanticTokenTypes_Type + , stTypeFamily = SemanticTokenTypes_Interface + , stRecField = 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_ f = STC - { stFunction :: !(f SemanticTokenTypes) - , stVariable :: !(f SemanticTokenTypes) - , stDataCon :: !(f SemanticTokenTypes) - , stTypeVariable :: !(f SemanticTokenTypes) - , stClassMethod :: !(f SemanticTokenTypes) - , stPatternSyn :: !(f SemanticTokenTypes) - , stTypeCon :: !(f SemanticTokenTypes) - , stClass :: !(f SemanticTokenTypes) - , stTypeSyn :: !(f SemanticTokenTypes) - , stTypeFamily :: !(f SemanticTokenTypes) - , stRecField :: !(f SemanticTokenTypes) - } deriving Generic -$(Rank2.TH.deriveAll ''SemanticTokensConfig_) - -withDef :: SemanticTokensConfig -> SemanticTokensConfig_ Maybe -> SemanticTokensConfig -withDef = Rank2.liftA2 (\x y -> Identity (fromMaybe (runIdentity x) y)) -instance FromJSON SemanticTokensConfig where parseJSON = fmap (withDef def) . parseJSON -lowerFirst :: String -> String -lowerFirst [] = [] -lowerFirst (x:xs) = toLower x : xs -stOption :: Options -stOption = defaultOptions { fieldLabelModifier = lowerFirst . drop 2 } -instance FromJSON (SemanticTokensConfig_ Maybe) where parseJSON = genericParseJSON stOption -instance ToJSON (SemanticTokensConfig_ Maybe) where toJSON = genericToJSON stOption -instance ToJSON SemanticTokensConfig where toJSON = genericToJSON stOption - -semanticConfigProperties :: Properties '[ 'PropertyKey "tokenMapping" ('TObject SemanticTokensConfig)] -semanticConfigProperties = - emptyProperties - & defineObjectProperty - #tokenMapping - "Configuration of the map from hs semantic token type to LSP default token type" - def -deriving instance Show SemanticTokensConfig +data SemanticTokensConfig = STC + { stFunction :: !SemanticTokenTypes + , stVariable :: !SemanticTokenTypes + , stDataCon :: !SemanticTokenTypes + , stTypeVariable :: !SemanticTokenTypes + , stClassMethod :: !SemanticTokenTypes + , stPatternSyn :: !SemanticTokenTypes + , stTypeCon :: !SemanticTokenTypes + , stClass :: !SemanticTokenTypes + , stTypeSyn :: !SemanticTokenTypes + , stTypeFamily :: !SemanticTokenTypes + , stRecField :: !SemanticTokenTypes + } deriving (Generic, Show) + instance Semigroup HsSemanticTokenType where -- one in higher enum is more specific @@ -169,7 +140,7 @@ data HieFunMaskKind kind where data SemanticLog = LogShake Shake.Log | LogNoAST FilePath - | LogConfig (SemanticTokensConfig ) + | LogConfig SemanticTokensConfig | LogMsg String | LogNoVF deriving (Show) diff --git a/plugins/hls-semantic-tokens-plugin/test/Main.hs b/plugins/hls-semantic-tokens-plugin/test/Main.hs index 03838690f5..09b33187b9 100644 --- a/plugins/hls-semantic-tokens-plugin/test/Main.hs +++ b/plugins/hls-semantic-tokens-plugin/test/Main.hs @@ -141,7 +141,7 @@ 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 [ "tokenMapping" .= object ["function" .= var] ] + let funcVar = object ["Function" .= var] var :: String var = "variable" do diff --git a/stack-lts21.yaml b/stack-lts21.yaml index f69b8a676e..b114550a17 100644 --- a/stack-lts21.yaml +++ b/stack-lts21.yaml @@ -54,8 +54,6 @@ extra-deps: - lsp-2.3.0.0 - lsp-test-0.16.0.1 - lsp-types-2.1.0.0 -- rank2classes-1.5.3 -- data-functor-logistic-0.0 # stan dependencies not found in the stackage snapshot - stan-0.1.2.0 diff --git a/stack.yaml b/stack.yaml index 93a4efca51..6eae9d00dd 100644 --- a/stack.yaml +++ b/stack.yaml @@ -57,8 +57,6 @@ extra-deps: - monad-dijkstra-0.1.1.4 - hw-prim-0.6.3.2 - optparse-applicative-0.17.1.0 -- rank2classes-1.5.3 -- data-functor-logistic-0.0 # stan and friends - stan-0.1.2.0 From e85366f1a456cd0c6e8283af08ed982665faedd9 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 12 Jan 2024 05:56:23 +0800 Subject: [PATCH 16/24] fix doc and cleanup --- .../src/Ide/Plugin/SemanticTokens/Internal.hs | 1 - .../src/Ide/Plugin/SemanticTokens/SemanticConfig.hs | 5 ++++- 2 files changed, 4 insertions(+), 2 deletions(-) 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 e86ef03cfa..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 @@ -59,7 +59,6 @@ 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, - SemanticTokenTypes, SemanticTokens, type (|?) (InL)) import Prelude hiding (span) 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 index 9701908f86..1f32684994 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs @@ -49,7 +49,10 @@ semanticDef :: SemanticTokensConfig semanticDef = def -- | it produces the following functions: --- semanticConfigProperties :: SemanticConfigProperties +-- semanticConfigProperties :: Properties '[ +-- 'PropertyKey "Variable" ('TEnum SemanticTokenTypes), +-- ... +-- ] -- useSemanticConfigAction :: PluginId -> Action SemanticTokensConfig mkSemanticConfigFunctions :: Q [Dec] mkSemanticConfigFunctions = do From 6653b03f5844503084e107e51653ec04be0c50d9 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 12 Jan 2024 05:59:32 +0800 Subject: [PATCH 17/24] delete content for /test/testdata/schema for now, since we are modifying the configuration --- .../schema/ghc92/default-config.golden.json | 139 --------- .../ghc92/vscode-extension-schema.golden.json | 282 ----------------- .../schema/ghc94/default-config.golden.json | 142 --------- .../ghc94/vscode-extension-schema.golden.json | 288 ------------------ .../schema/ghc96/default-config.golden.json | 142 --------- .../ghc96/vscode-extension-schema.golden.json | 288 ------------------ .../schema/ghc98/default-config.golden.json | 104 ------- .../ghc98/vscode-extension-schema.golden.json | 204 ------------- 8 files changed, 1589 deletions(-) delete mode 100644 test/testdata/schema/ghc92/default-config.golden.json delete mode 100644 test/testdata/schema/ghc92/vscode-extension-schema.golden.json delete mode 100644 test/testdata/schema/ghc94/default-config.golden.json delete mode 100644 test/testdata/schema/ghc94/vscode-extension-schema.golden.json delete mode 100644 test/testdata/schema/ghc96/default-config.golden.json delete mode 100644 test/testdata/schema/ghc96/vscode-extension-schema.golden.json delete mode 100644 test/testdata/schema/ghc98/default-config.golden.json delete mode 100644 test/testdata/schema/ghc98/vscode-extension-schema.golden.json diff --git a/test/testdata/schema/ghc92/default-config.golden.json b/test/testdata/schema/ghc92/default-config.golden.json deleted file mode 100644 index 140214aacc..0000000000 --- a/test/testdata/schema/ghc92/default-config.golden.json +++ /dev/null @@ -1,139 +0,0 @@ -{ - "checkParents": "CheckOnSave", - "checkProject": true, - "formattingProvider": "ormolu", - "maxCompletions": 40, - "plugin": { - "alternateNumberFormat": { - "globalOn": true - }, - "cabal": { - "codeActionsOn": true, - "completionOn": true - }, - "callHierarchy": { - "globalOn": true - }, - "changeTypeSignature": { - "globalOn": true - }, - "class": { - "codeActionsOn": true, - "codeLensOn": true - }, - "eval": { - "config": { - "diff": true, - "exception": false - }, - "globalOn": true - }, - "explicit-fields": { - "globalOn": true - }, - "explicit-fixity": { - "globalOn": true - }, - "fourmolu": { - "config": { - "external": false - } - }, - "gadt": { - "globalOn": true - }, - "ghcide-code-actions-bindings": { - "globalOn": true - }, - "ghcide-code-actions-fill-holes": { - "globalOn": true - }, - "ghcide-code-actions-imports-exports": { - "globalOn": true - }, - "ghcide-code-actions-type-signatures": { - "globalOn": true - }, - "ghcide-completions": { - "config": { - "autoExtendOn": true, - "snippetsOn": true - }, - "globalOn": true - }, - "ghcide-hover-and-symbols": { - "hoverOn": true, - "symbolsOn": true - }, - "ghcide-type-lenses": { - "config": { - "mode": "always" - }, - "globalOn": true - }, - "hlint": { - "codeActionsOn": true, - "config": { - "flags": [] - }, - "diagnosticsOn": true - }, - "importLens": { - "codeActionsOn": true, - "codeLensOn": true - }, - "moduleName": { - "globalOn": true - }, - "ormolu": { - "config": { - "external": false - } - }, - "overloaded-record-dot": { - "globalOn": true - }, - "pragmas-completion": { - "globalOn": true - }, - "pragmas-disable": { - "globalOn": true - }, - "pragmas-suggest": { - "globalOn": true - }, - "qualifyImportedNames": { - "globalOn": true - }, - "rename": { - "config": { - "crossModule": false - }, - "globalOn": true - }, - "retrie": { - "globalOn": true - }, - "semanticTokens": { - "config": { - "tokenMapping": { - "class": "class", - "classMethod": "method", - "dataCon": "enumMember", - "function": "function", - "patternSyn": "macro", - "recField": "property", - "typeCon": "enum", - "typeFamily": "interface", - "typeSyn": "type", - "typeVariable": "typeParameter", - "variable": "variable" - } - }, - "globalOn": false - }, - "splice": { - "globalOn": true - } - } -} diff --git a/test/testdata/schema/ghc92/vscode-extension-schema.golden.json b/test/testdata/schema/ghc92/vscode-extension-schema.golden.json deleted file mode 100644 index 6f408bbd36..0000000000 --- a/test/testdata/schema/ghc92/vscode-extension-schema.golden.json +++ /dev/null @@ -1,282 +0,0 @@ -{ - "haskell.plugin.alternateNumberFormat.globalOn": { - "default": true, - "description": "Enables alternateNumberFormat plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.codeActionsOn": { - "default": true, - "description": "Enables cabal code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.completionOn": { - "default": true, - "description": "Enables cabal completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.callHierarchy.globalOn": { - "default": true, - "description": "Enables callHierarchy plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.changeTypeSignature.globalOn": { - "default": true, - "description": "Enables changeTypeSignature plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeActionsOn": { - "default": true, - "description": "Enables class code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeLensOn": { - "default": true, - "description": "Enables class code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.diff": { - "default": true, - "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.exception": { - "default": false, - "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.globalOn": { - "default": true, - "description": "Enables eval plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fields.globalOn": { - "default": true, - "description": "Enables explicit-fields plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fixity.globalOn": { - "default": true, - "description": "Enables explicit-fixity plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.fourmolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.gadt.globalOn": { - "default": true, - "description": "Enables gadt plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-bindings.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-bindings plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-fill-holes plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-imports-exports plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-type-signatures plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.autoExtendOn": { - "default": true, - "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.snippetsOn": { - "default": true, - "markdownDescription": "Inserts snippets when using code completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.globalOn": { - "default": true, - "description": "Enables ghcide-completions plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols hover", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols symbols", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-type-lenses.config.mode": { - "default": "always", - "description": "Control how type lenses are shown", - "enum": [ - "always", - "exported", - "diagnostics" - ], - "enumDescriptions": [ - "Always displays type lenses of global bindings", - "Only display type lenses of exported global bindings", - "Follows error messages produced by GHC about missing signatures" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.ghcide-type-lenses.globalOn": { - "default": true, - "description": "Enables ghcide-type-lenses plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.codeActionsOn": { - "default": true, - "description": "Enables hlint code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.config.flags": { - "default": [], - "markdownDescription": "Flags used by hlint", - "scope": "resource", - "type": "array" - }, - "haskell.plugin.hlint.diagnosticsOn": { - "default": true, - "description": "Enables hlint diagnostics", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeActionsOn": { - "default": true, - "description": "Enables importLens code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeLensOn": { - "default": true, - "description": "Enables importLens code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.moduleName.globalOn": { - "default": true, - "description": "Enables moduleName plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ormolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.overloaded-record-dot.globalOn": { - "default": true, - "description": "Enables overloaded-record-dot plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-completion.globalOn": { - "default": true, - "description": "Enables pragmas-completion plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-disable.globalOn": { - "default": true, - "description": "Enables pragmas-disable plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-suggest.globalOn": { - "default": true, - "description": "Enables pragmas-suggest plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.qualifyImportedNames.globalOn": { - "default": true, - "description": "Enables qualifyImportedNames plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.config.crossModule": { - "default": false, - "markdownDescription": "Enable experimental cross-module renaming", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.globalOn": { - "default": true, - "description": "Enables rename plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.retrie.globalOn": { - "default": true, - "description": "Enables retrie plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.semanticTokens.config.tokenMapping": { - "default": { - "class": "class", - "classMethod": "method", - "dataCon": "enumMember", - "function": "function", - "patternSyn": "macro", - "recField": "property", - "typeCon": "enum", - "typeFamily": "interface", - "typeSyn": "type", - "typeVariable": "typeParameter", - "variable": "variable" - }, - "markdownDescription": "Configuration of the map from hs semantic token type to LSP default token type", - "scope": "resource", - "type": "object" - }, - "haskell.plugin.semanticTokens.globalOn": { - "default": false, - "description": "Enables semanticTokens plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.splice.globalOn": { - "default": true, - "description": "Enables splice plugin", - "scope": "resource", - "type": "boolean" - } -} diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json deleted file mode 100644 index 39ce29c0cc..0000000000 --- a/test/testdata/schema/ghc94/default-config.golden.json +++ /dev/null @@ -1,142 +0,0 @@ -{ - "checkParents": "CheckOnSave", - "checkProject": true, - "formattingProvider": "ormolu", - "maxCompletions": 40, - "plugin": { - "alternateNumberFormat": { - "globalOn": true - }, - "cabal": { - "codeActionsOn": true, - "completionOn": true - }, - "callHierarchy": { - "globalOn": true - }, - "changeTypeSignature": { - "globalOn": true - }, - "class": { - "codeActionsOn": true, - "codeLensOn": true - }, - "eval": { - "config": { - "diff": true, - "exception": false - }, - "globalOn": true - }, - "explicit-fields": { - "globalOn": true - }, - "explicit-fixity": { - "globalOn": true - }, - "fourmolu": { - "config": { - "external": false - } - }, - "gadt": { - "globalOn": true - }, - "ghcide-code-actions-bindings": { - "globalOn": true - }, - "ghcide-code-actions-fill-holes": { - "globalOn": true - }, - "ghcide-code-actions-imports-exports": { - "globalOn": true - }, - "ghcide-code-actions-type-signatures": { - "globalOn": true - }, - "ghcide-completions": { - "config": { - "autoExtendOn": true, - "snippetsOn": true - }, - "globalOn": true - }, - "ghcide-hover-and-symbols": { - "hoverOn": true, - "symbolsOn": true - }, - "ghcide-type-lenses": { - "config": { - "mode": "always" - }, - "globalOn": true - }, - "hlint": { - "codeActionsOn": true, - "config": { - "flags": [] - }, - "diagnosticsOn": true - }, - "importLens": { - "codeActionsOn": true, - "codeLensOn": true - }, - "moduleName": { - "globalOn": true - }, - "ormolu": { - "config": { - "external": false - } - }, - "overloaded-record-dot": { - "globalOn": true - }, - "pragmas-completion": { - "globalOn": true - }, - "pragmas-disable": { - "globalOn": true - }, - "pragmas-suggest": { - "globalOn": true - }, - "qualifyImportedNames": { - "globalOn": true - }, - "rename": { - "config": { - "crossModule": false - }, - "globalOn": true - }, - "retrie": { - "globalOn": true - }, - "semanticTokens": { - "config": { - "tokenMapping": { - "class": "class", - "classMethod": "method", - "dataCon": "enumMember", - "function": "function", - "patternSyn": "macro", - "recField": "property", - "typeCon": "enum", - "typeFamily": "interface", - "typeSyn": "type", - "typeVariable": "typeParameter", - "variable": "variable" - } - }, - "globalOn": false - }, - "splice": { - "globalOn": true - }, - "stan": { - "globalOn": false - } - } -} diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json deleted file mode 100644 index 2a13be8252..0000000000 --- a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json +++ /dev/null @@ -1,288 +0,0 @@ -{ - "haskell.plugin.alternateNumberFormat.globalOn": { - "default": true, - "description": "Enables alternateNumberFormat plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.codeActionsOn": { - "default": true, - "description": "Enables cabal code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.completionOn": { - "default": true, - "description": "Enables cabal completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.callHierarchy.globalOn": { - "default": true, - "description": "Enables callHierarchy plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.changeTypeSignature.globalOn": { - "default": true, - "description": "Enables changeTypeSignature plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeActionsOn": { - "default": true, - "description": "Enables class code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeLensOn": { - "default": true, - "description": "Enables class code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.diff": { - "default": true, - "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.exception": { - "default": false, - "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.globalOn": { - "default": true, - "description": "Enables eval plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fields.globalOn": { - "default": true, - "description": "Enables explicit-fields plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fixity.globalOn": { - "default": true, - "description": "Enables explicit-fixity plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.fourmolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.gadt.globalOn": { - "default": true, - "description": "Enables gadt plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-bindings.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-bindings plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-fill-holes plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-imports-exports plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-type-signatures plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.autoExtendOn": { - "default": true, - "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.snippetsOn": { - "default": true, - "markdownDescription": "Inserts snippets when using code completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.globalOn": { - "default": true, - "description": "Enables ghcide-completions plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols hover", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols symbols", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-type-lenses.config.mode": { - "default": "always", - "description": "Control how type lenses are shown", - "enum": [ - "always", - "exported", - "diagnostics" - ], - "enumDescriptions": [ - "Always displays type lenses of global bindings", - "Only display type lenses of exported global bindings", - "Follows error messages produced by GHC about missing signatures" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.ghcide-type-lenses.globalOn": { - "default": true, - "description": "Enables ghcide-type-lenses plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.codeActionsOn": { - "default": true, - "description": "Enables hlint code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.config.flags": { - "default": [], - "markdownDescription": "Flags used by hlint", - "scope": "resource", - "type": "array" - }, - "haskell.plugin.hlint.diagnosticsOn": { - "default": true, - "description": "Enables hlint diagnostics", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeActionsOn": { - "default": true, - "description": "Enables importLens code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeLensOn": { - "default": true, - "description": "Enables importLens code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.moduleName.globalOn": { - "default": true, - "description": "Enables moduleName plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ormolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.overloaded-record-dot.globalOn": { - "default": true, - "description": "Enables overloaded-record-dot plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-completion.globalOn": { - "default": true, - "description": "Enables pragmas-completion plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-disable.globalOn": { - "default": true, - "description": "Enables pragmas-disable plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-suggest.globalOn": { - "default": true, - "description": "Enables pragmas-suggest plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.qualifyImportedNames.globalOn": { - "default": true, - "description": "Enables qualifyImportedNames plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.config.crossModule": { - "default": false, - "markdownDescription": "Enable experimental cross-module renaming", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.globalOn": { - "default": true, - "description": "Enables rename plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.retrie.globalOn": { - "default": true, - "description": "Enables retrie plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.semanticTokens.config.tokenMapping": { - "default": { - "class": "class", - "classMethod": "method", - "dataCon": "enumMember", - "function": "function", - "patternSyn": "macro", - "recField": "property", - "typeCon": "enum", - "typeFamily": "interface", - "typeSyn": "type", - "typeVariable": "typeParameter", - "variable": "variable" - }, - "markdownDescription": "Configuration of the map from hs semantic token type to LSP default token type", - "scope": "resource", - "type": "object" - }, - "haskell.plugin.semanticTokens.globalOn": { - "default": false, - "description": "Enables semanticTokens plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.splice.globalOn": { - "default": true, - "description": "Enables splice plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.stan.globalOn": { - "default": false, - "description": "Enables stan plugin", - "scope": "resource", - "type": "boolean" - } -} diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json deleted file mode 100644 index 39ce29c0cc..0000000000 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ /dev/null @@ -1,142 +0,0 @@ -{ - "checkParents": "CheckOnSave", - "checkProject": true, - "formattingProvider": "ormolu", - "maxCompletions": 40, - "plugin": { - "alternateNumberFormat": { - "globalOn": true - }, - "cabal": { - "codeActionsOn": true, - "completionOn": true - }, - "callHierarchy": { - "globalOn": true - }, - "changeTypeSignature": { - "globalOn": true - }, - "class": { - "codeActionsOn": true, - "codeLensOn": true - }, - "eval": { - "config": { - "diff": true, - "exception": false - }, - "globalOn": true - }, - "explicit-fields": { - "globalOn": true - }, - "explicit-fixity": { - "globalOn": true - }, - "fourmolu": { - "config": { - "external": false - } - }, - "gadt": { - "globalOn": true - }, - "ghcide-code-actions-bindings": { - "globalOn": true - }, - "ghcide-code-actions-fill-holes": { - "globalOn": true - }, - "ghcide-code-actions-imports-exports": { - "globalOn": true - }, - "ghcide-code-actions-type-signatures": { - "globalOn": true - }, - "ghcide-completions": { - "config": { - "autoExtendOn": true, - "snippetsOn": true - }, - "globalOn": true - }, - "ghcide-hover-and-symbols": { - "hoverOn": true, - "symbolsOn": true - }, - "ghcide-type-lenses": { - "config": { - "mode": "always" - }, - "globalOn": true - }, - "hlint": { - "codeActionsOn": true, - "config": { - "flags": [] - }, - "diagnosticsOn": true - }, - "importLens": { - "codeActionsOn": true, - "codeLensOn": true - }, - "moduleName": { - "globalOn": true - }, - "ormolu": { - "config": { - "external": false - } - }, - "overloaded-record-dot": { - "globalOn": true - }, - "pragmas-completion": { - "globalOn": true - }, - "pragmas-disable": { - "globalOn": true - }, - "pragmas-suggest": { - "globalOn": true - }, - "qualifyImportedNames": { - "globalOn": true - }, - "rename": { - "config": { - "crossModule": false - }, - "globalOn": true - }, - "retrie": { - "globalOn": true - }, - "semanticTokens": { - "config": { - "tokenMapping": { - "class": "class", - "classMethod": "method", - "dataCon": "enumMember", - "function": "function", - "patternSyn": "macro", - "recField": "property", - "typeCon": "enum", - "typeFamily": "interface", - "typeSyn": "type", - "typeVariable": "typeParameter", - "variable": "variable" - } - }, - "globalOn": false - }, - "splice": { - "globalOn": true - }, - "stan": { - "globalOn": false - } - } -} diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json deleted file mode 100644 index 2a13be8252..0000000000 --- a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json +++ /dev/null @@ -1,288 +0,0 @@ -{ - "haskell.plugin.alternateNumberFormat.globalOn": { - "default": true, - "description": "Enables alternateNumberFormat plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.codeActionsOn": { - "default": true, - "description": "Enables cabal code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.completionOn": { - "default": true, - "description": "Enables cabal completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.callHierarchy.globalOn": { - "default": true, - "description": "Enables callHierarchy plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.changeTypeSignature.globalOn": { - "default": true, - "description": "Enables changeTypeSignature plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeActionsOn": { - "default": true, - "description": "Enables class code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeLensOn": { - "default": true, - "description": "Enables class code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.diff": { - "default": true, - "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.exception": { - "default": false, - "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.globalOn": { - "default": true, - "description": "Enables eval plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fields.globalOn": { - "default": true, - "description": "Enables explicit-fields plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fixity.globalOn": { - "default": true, - "description": "Enables explicit-fixity plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.fourmolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.gadt.globalOn": { - "default": true, - "description": "Enables gadt plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-bindings.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-bindings plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-fill-holes plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-imports-exports plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-type-signatures plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.autoExtendOn": { - "default": true, - "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.snippetsOn": { - "default": true, - "markdownDescription": "Inserts snippets when using code completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.globalOn": { - "default": true, - "description": "Enables ghcide-completions plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols hover", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols symbols", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-type-lenses.config.mode": { - "default": "always", - "description": "Control how type lenses are shown", - "enum": [ - "always", - "exported", - "diagnostics" - ], - "enumDescriptions": [ - "Always displays type lenses of global bindings", - "Only display type lenses of exported global bindings", - "Follows error messages produced by GHC about missing signatures" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.ghcide-type-lenses.globalOn": { - "default": true, - "description": "Enables ghcide-type-lenses plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.codeActionsOn": { - "default": true, - "description": "Enables hlint code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.config.flags": { - "default": [], - "markdownDescription": "Flags used by hlint", - "scope": "resource", - "type": "array" - }, - "haskell.plugin.hlint.diagnosticsOn": { - "default": true, - "description": "Enables hlint diagnostics", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeActionsOn": { - "default": true, - "description": "Enables importLens code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeLensOn": { - "default": true, - "description": "Enables importLens code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.moduleName.globalOn": { - "default": true, - "description": "Enables moduleName plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ormolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.overloaded-record-dot.globalOn": { - "default": true, - "description": "Enables overloaded-record-dot plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-completion.globalOn": { - "default": true, - "description": "Enables pragmas-completion plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-disable.globalOn": { - "default": true, - "description": "Enables pragmas-disable plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-suggest.globalOn": { - "default": true, - "description": "Enables pragmas-suggest plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.qualifyImportedNames.globalOn": { - "default": true, - "description": "Enables qualifyImportedNames plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.config.crossModule": { - "default": false, - "markdownDescription": "Enable experimental cross-module renaming", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.globalOn": { - "default": true, - "description": "Enables rename plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.retrie.globalOn": { - "default": true, - "description": "Enables retrie plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.semanticTokens.config.tokenMapping": { - "default": { - "class": "class", - "classMethod": "method", - "dataCon": "enumMember", - "function": "function", - "patternSyn": "macro", - "recField": "property", - "typeCon": "enum", - "typeFamily": "interface", - "typeSyn": "type", - "typeVariable": "typeParameter", - "variable": "variable" - }, - "markdownDescription": "Configuration of the map from hs semantic token type to LSP default token type", - "scope": "resource", - "type": "object" - }, - "haskell.plugin.semanticTokens.globalOn": { - "default": false, - "description": "Enables semanticTokens plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.splice.globalOn": { - "default": true, - "description": "Enables splice plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.stan.globalOn": { - "default": false, - "description": "Enables stan plugin", - "scope": "resource", - "type": "boolean" - } -} diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json deleted file mode 100644 index eac9653f62..0000000000 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ /dev/null @@ -1,104 +0,0 @@ -{ - "checkParents": "CheckOnSave", - "checkProject": true, - "formattingProvider": "ormolu", - "maxCompletions": 40, - "plugin": { - "alternateNumberFormat": { - "globalOn": true - }, - "cabal": { - "codeActionsOn": true, - "completionOn": true - }, - "callHierarchy": { - "globalOn": true - }, - "changeTypeSignature": { - "globalOn": true - }, - "eval": { - "config": { - "diff": true, - "exception": false - }, - "globalOn": true - }, - "explicit-fields": { - "globalOn": true - }, - "explicit-fixity": { - "globalOn": true - }, - "fourmolu": { - "config": { - "external": false - } - }, - "ghcide-completions": { - "config": { - "autoExtendOn": true, - "snippetsOn": true - }, - "globalOn": true - }, - "ghcide-hover-and-symbols": { - "hoverOn": true, - "symbolsOn": true - }, - "ghcide-type-lenses": { - "config": { - "mode": "always" - }, - "globalOn": true - }, - "importLens": { - "codeActionsOn": true, - "codeLensOn": true - }, - "moduleName": { - "globalOn": true - }, - "ormolu": { - "config": { - "external": false - } - }, - "overloaded-record-dot": { - "globalOn": true - }, - "pragmas-completion": { - "globalOn": true - }, - "pragmas-disable": { - "globalOn": true - }, - "pragmas-suggest": { - "globalOn": true - }, - "qualifyImportedNames": { - "globalOn": true - }, - "semanticTokens": { - "config": { - "tokenMapping": { - "class": "class", - "classMethod": "method", - "dataCon": "enumMember", - "function": "function", - "patternSyn": "macro", - "recField": "property", - "typeCon": "enum", - "typeFamily": "interface", - "typeSyn": "type", - "typeVariable": "typeParameter", - "variable": "variable" - } - }, - "globalOn": false - }, - "stan": { - "globalOn": false - } - } -} diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json deleted file mode 100644 index 8c4ddaceab..0000000000 --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ /dev/null @@ -1,204 +0,0 @@ -{ - "haskell.plugin.alternateNumberFormat.globalOn": { - "default": true, - "description": "Enables alternateNumberFormat plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.codeActionsOn": { - "default": true, - "description": "Enables cabal code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.completionOn": { - "default": true, - "description": "Enables cabal completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.callHierarchy.globalOn": { - "default": true, - "description": "Enables callHierarchy plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.changeTypeSignature.globalOn": { - "default": true, - "description": "Enables changeTypeSignature plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.diff": { - "default": true, - "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.exception": { - "default": false, - "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.globalOn": { - "default": true, - "description": "Enables eval plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fields.globalOn": { - "default": true, - "description": "Enables explicit-fields plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fixity.globalOn": { - "default": true, - "description": "Enables explicit-fixity plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.fourmolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.autoExtendOn": { - "default": true, - "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.snippetsOn": { - "default": true, - "markdownDescription": "Inserts snippets when using code completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.globalOn": { - "default": true, - "description": "Enables ghcide-completions plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols hover", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols symbols", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-type-lenses.config.mode": { - "default": "always", - "description": "Control how type lenses are shown", - "enum": [ - "always", - "exported", - "diagnostics" - ], - "enumDescriptions": [ - "Always displays type lenses of global bindings", - "Only display type lenses of exported global bindings", - "Follows error messages produced by GHC about missing signatures" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.ghcide-type-lenses.globalOn": { - "default": true, - "description": "Enables ghcide-type-lenses plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeActionsOn": { - "default": true, - "description": "Enables importLens code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeLensOn": { - "default": true, - "description": "Enables importLens code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.moduleName.globalOn": { - "default": true, - "description": "Enables moduleName plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ormolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.overloaded-record-dot.globalOn": { - "default": true, - "description": "Enables overloaded-record-dot plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-completion.globalOn": { - "default": true, - "description": "Enables pragmas-completion plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-disable.globalOn": { - "default": true, - "description": "Enables pragmas-disable plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-suggest.globalOn": { - "default": true, - "description": "Enables pragmas-suggest plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.qualifyImportedNames.globalOn": { - "default": true, - "description": "Enables qualifyImportedNames plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.semanticTokens.config.tokenMapping": { - "default": { - "class": "class", - "classMethod": "method", - "dataCon": "enumMember", - "function": "function", - "patternSyn": "macro", - "recField": "property", - "typeCon": "enum", - "typeFamily": "interface", - "typeSyn": "type", - "typeVariable": "typeParameter", - "variable": "variable" - }, - "markdownDescription": "Configuration of the map from hs semantic token type to LSP default token type", - "scope": "resource", - "type": "object" - }, - "haskell.plugin.semanticTokens.globalOn": { - "default": false, - "description": "Enables semanticTokens plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.stan.globalOn": { - "default": false, - "description": "Enables stan plugin", - "scope": "resource", - "type": "boolean" - } -} From 4d11ac79f3c0eab8d3f53da621f411d12391e0b9 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 12 Jan 2024 14:22:30 +0800 Subject: [PATCH 18/24] semantic config keys use lower case in the first element --- .../src/Ide/Plugin/SemanticTokens/SemanticConfig.hs | 9 +++++++-- plugins/hls-semantic-tokens-plugin/test/Main.hs | 2 +- 2 files changed, 8 insertions(+), 3 deletions(-) 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 index 1f32684994..7a6eba2015 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs @@ -7,6 +7,7 @@ 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 @@ -35,6 +36,10 @@ lspTokenTypeDescriptions = allHsTokenTypes :: [HsSemanticTokenType] allHsTokenTypes = enumFrom minBound +lowerFirst :: String -> String +lowerFirst [] = [] +lowerFirst (x:xs) = toLower x : xs + allHsTokenNameStrings :: [String] allHsTokenNameStrings = map (drop 1 . show) allHsTokenTypes @@ -60,9 +65,9 @@ mkSemanticConfigFunctions = do let semanticConfigPropertiesName = mkName "semanticConfigProperties" let useSemanticConfigActionName = mkName "useSemanticConfigAction" let - allLabels = map LabelE allHsTokenNameStrings + allLabels = map (LabelE . lowerFirst) allHsTokenNameStrings allFieldsNames = map (mkName . toConfigName) allHsTokenNameStrings - allVariableNames = map (mkName . ("variable_" <>) . toConfigName) allHsTokenNameStrings + allVariableNames = map (mkName . ("_variable_" <>) . toConfigName) allHsTokenNameStrings -- <- useSemanticConfigAction label pid config mkGetProperty (variable, label) = BindS diff --git a/plugins/hls-semantic-tokens-plugin/test/Main.hs b/plugins/hls-semantic-tokens-plugin/test/Main.hs index 09b33187b9..5590d6841c 100644 --- a/plugins/hls-semantic-tokens-plugin/test/Main.hs +++ b/plugins/hls-semantic-tokens-plugin/test/Main.hs @@ -141,7 +141,7 @@ 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 ["Function" .= var] + let funcVar = object ["function" .= var] var :: String var = "variable" do From 38195673b4af9e9a5bdf5aaff69e5f3b4d299b38 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 12 Jan 2024 14:56:13 +0800 Subject: [PATCH 19/24] add config generation scheme test --- .../src/Ide/Plugin/SemanticTokens/Mappings.hs | 2 - .../schema/ghc92/default-config.golden.json | 124 ++++++++ .../ghc92/vscode-extension-schema.golden.json | 264 +++++++++++++++++ .../schema/ghc94/default-config.golden.json | 127 ++++++++ .../ghc94/vscode-extension-schema.golden.json | 270 ++++++++++++++++++ .../schema/ghc96/default-config.golden.json | 127 ++++++++ .../ghc96/vscode-extension-schema.golden.json | 270 ++++++++++++++++++ .../schema/ghc98/default-config.golden.json | 89 ++++++ .../ghc98/vscode-extension-schema.golden.json | 186 ++++++++++++ 9 files changed, 1457 insertions(+), 2 deletions(-) create mode 100644 test/testdata/schema/ghc92/default-config.golden.json create mode 100644 test/testdata/schema/ghc92/vscode-extension-schema.golden.json create mode 100644 test/testdata/schema/ghc94/default-config.golden.json create mode 100644 test/testdata/schema/ghc94/vscode-extension-schema.golden.json create mode 100644 test/testdata/schema/ghc96/default-config.golden.json create mode 100644 test/testdata/schema/ghc96/vscode-extension-schema.golden.json create mode 100644 test/testdata/schema/ghc98/default-config.golden.json create mode 100644 test/testdata/schema/ghc98/vscode-extension-schema.golden.json 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 6ed46a1bee..1d53d7ac15 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 @@ -2,8 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} - - -- | -- This module provides mappings to convert token type information in the Haskell IDE plugin. It includes functions for: -- diff --git a/test/testdata/schema/ghc92/default-config.golden.json b/test/testdata/schema/ghc92/default-config.golden.json new file mode 100644 index 0000000000..949df9ed88 --- /dev/null +++ b/test/testdata/schema/ghc92/default-config.golden.json @@ -0,0 +1,124 @@ +{ + "checkParents": "CheckOnSave", + "checkProject": true, + "formattingProvider": "ormolu", + "maxCompletions": 40, + "plugin": { + "alternateNumberFormat": { + "globalOn": true + }, + "cabal": { + "codeActionsOn": true, + "completionOn": true + }, + "callHierarchy": { + "globalOn": true + }, + "changeTypeSignature": { + "globalOn": true + }, + "class": { + "codeActionsOn": true, + "codeLensOn": true + }, + "eval": { + "config": { + "diff": true, + "exception": false + }, + "globalOn": true + }, + "explicit-fields": { + "globalOn": true + }, + "explicit-fixity": { + "globalOn": true + }, + "fourmolu": { + "config": { + "external": false + } + }, + "gadt": { + "globalOn": true + }, + "ghcide-code-actions-bindings": { + "globalOn": true + }, + "ghcide-code-actions-fill-holes": { + "globalOn": true + }, + "ghcide-code-actions-imports-exports": { + "globalOn": true + }, + "ghcide-code-actions-type-signatures": { + "globalOn": true + }, + "ghcide-completions": { + "config": { + "autoExtendOn": true, + "snippetsOn": true + }, + "globalOn": true + }, + "ghcide-hover-and-symbols": { + "hoverOn": true, + "symbolsOn": true + }, + "ghcide-type-lenses": { + "config": { + "mode": "always" + }, + "globalOn": true + }, + "hlint": { + "codeActionsOn": true, + "config": { + "flags": [] + }, + "diagnosticsOn": true + }, + "importLens": { + "codeActionsOn": true, + "codeLensOn": true + }, + "moduleName": { + "globalOn": true + }, + "ormolu": { + "config": { + "external": false + } + }, + "overloaded-record-dot": { + "globalOn": true + }, + "pragmas-completion": { + "globalOn": true + }, + "pragmas-disable": { + "globalOn": true + }, + "pragmas-suggest": { + "globalOn": true + }, + "qualifyImportedNames": { + "globalOn": true + }, + "rename": { + "config": { + "crossModule": false + }, + "globalOn": true + }, + "retrie": { + "globalOn": true + }, + "semanticTokens": { + "globalOn": false + }, + "splice": { + "globalOn": true + } + } +} diff --git a/test/testdata/schema/ghc92/vscode-extension-schema.golden.json b/test/testdata/schema/ghc92/vscode-extension-schema.golden.json new file mode 100644 index 0000000000..01c36f1562 --- /dev/null +++ b/test/testdata/schema/ghc92/vscode-extension-schema.golden.json @@ -0,0 +1,264 @@ +{ + "haskell.plugin.alternateNumberFormat.globalOn": { + "default": true, + "description": "Enables alternateNumberFormat plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.codeActionsOn": { + "default": true, + "description": "Enables cabal code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.completionOn": { + "default": true, + "description": "Enables cabal completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.callHierarchy.globalOn": { + "default": true, + "description": "Enables callHierarchy plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.changeTypeSignature.globalOn": { + "default": true, + "description": "Enables changeTypeSignature plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.class.codeActionsOn": { + "default": true, + "description": "Enables class code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.class.codeLensOn": { + "default": true, + "description": "Enables class code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.diff": { + "default": true, + "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.exception": { + "default": false, + "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.globalOn": { + "default": true, + "description": "Enables eval plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fields.globalOn": { + "default": true, + "description": "Enables explicit-fields plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fixity.globalOn": { + "default": true, + "description": "Enables explicit-fixity plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.fourmolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.gadt.globalOn": { + "default": true, + "description": "Enables gadt plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-bindings.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-bindings plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-fill-holes plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-imports-exports plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-type-signatures plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.autoExtendOn": { + "default": true, + "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.snippetsOn": { + "default": true, + "markdownDescription": "Inserts snippets when using code completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.globalOn": { + "default": true, + "description": "Enables ghcide-completions plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols hover", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols symbols", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-type-lenses.config.mode": { + "default": "always", + "description": "Control how type lenses are shown", + "enum": [ + "always", + "exported", + "diagnostics" + ], + "enumDescriptions": [ + "Always displays type lenses of global bindings", + "Only display type lenses of exported global bindings", + "Follows error messages produced by GHC about missing signatures" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.ghcide-type-lenses.globalOn": { + "default": true, + "description": "Enables ghcide-type-lenses plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.codeActionsOn": { + "default": true, + "description": "Enables hlint code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.config.flags": { + "default": [], + "markdownDescription": "Flags used by hlint", + "scope": "resource", + "type": "array" + }, + "haskell.plugin.hlint.diagnosticsOn": { + "default": true, + "description": "Enables hlint diagnostics", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeActionsOn": { + "default": true, + "description": "Enables importLens code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeLensOn": { + "default": true, + "description": "Enables importLens code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.moduleName.globalOn": { + "default": true, + "description": "Enables moduleName plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ormolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.overloaded-record-dot.globalOn": { + "default": true, + "description": "Enables overloaded-record-dot plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-completion.globalOn": { + "default": true, + "description": "Enables pragmas-completion plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-disable.globalOn": { + "default": true, + "description": "Enables pragmas-disable plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-suggest.globalOn": { + "default": true, + "description": "Enables pragmas-suggest plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.qualifyImportedNames.globalOn": { + "default": true, + "description": "Enables qualifyImportedNames plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.rename.config.crossModule": { + "default": false, + "markdownDescription": "Enable experimental cross-module renaming", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.rename.globalOn": { + "default": true, + "description": "Enables rename plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.retrie.globalOn": { + "default": true, + "description": "Enables retrie plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.semanticTokens.globalOn": { + "default": false, + "description": "Enables semanticTokens plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.splice.globalOn": { + "default": true, + "description": "Enables splice plugin", + "scope": "resource", + "type": "boolean" + } +} diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json new file mode 100644 index 0000000000..96f2567cec --- /dev/null +++ b/test/testdata/schema/ghc94/default-config.golden.json @@ -0,0 +1,127 @@ +{ + "checkParents": "CheckOnSave", + "checkProject": true, + "formattingProvider": "ormolu", + "maxCompletions": 40, + "plugin": { + "alternateNumberFormat": { + "globalOn": true + }, + "cabal": { + "codeActionsOn": true, + "completionOn": true + }, + "callHierarchy": { + "globalOn": true + }, + "changeTypeSignature": { + "globalOn": true + }, + "class": { + "codeActionsOn": true, + "codeLensOn": true + }, + "eval": { + "config": { + "diff": true, + "exception": false + }, + "globalOn": true + }, + "explicit-fields": { + "globalOn": true + }, + "explicit-fixity": { + "globalOn": true + }, + "fourmolu": { + "config": { + "external": false + } + }, + "gadt": { + "globalOn": true + }, + "ghcide-code-actions-bindings": { + "globalOn": true + }, + "ghcide-code-actions-fill-holes": { + "globalOn": true + }, + "ghcide-code-actions-imports-exports": { + "globalOn": true + }, + "ghcide-code-actions-type-signatures": { + "globalOn": true + }, + "ghcide-completions": { + "config": { + "autoExtendOn": true, + "snippetsOn": true + }, + "globalOn": true + }, + "ghcide-hover-and-symbols": { + "hoverOn": true, + "symbolsOn": true + }, + "ghcide-type-lenses": { + "config": { + "mode": "always" + }, + "globalOn": true + }, + "hlint": { + "codeActionsOn": true, + "config": { + "flags": [] + }, + "diagnosticsOn": true + }, + "importLens": { + "codeActionsOn": true, + "codeLensOn": true + }, + "moduleName": { + "globalOn": true + }, + "ormolu": { + "config": { + "external": false + } + }, + "overloaded-record-dot": { + "globalOn": true + }, + "pragmas-completion": { + "globalOn": true + }, + "pragmas-disable": { + "globalOn": true + }, + "pragmas-suggest": { + "globalOn": true + }, + "qualifyImportedNames": { + "globalOn": true + }, + "rename": { + "config": { + "crossModule": false + }, + "globalOn": true + }, + "retrie": { + "globalOn": true + }, + "semanticTokens": { + "globalOn": false + }, + "splice": { + "globalOn": true + }, + "stan": { + "globalOn": false + } + } +} diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json new file mode 100644 index 0000000000..349b07571d --- /dev/null +++ b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json @@ -0,0 +1,270 @@ +{ + "haskell.plugin.alternateNumberFormat.globalOn": { + "default": true, + "description": "Enables alternateNumberFormat plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.codeActionsOn": { + "default": true, + "description": "Enables cabal code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.completionOn": { + "default": true, + "description": "Enables cabal completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.callHierarchy.globalOn": { + "default": true, + "description": "Enables callHierarchy plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.changeTypeSignature.globalOn": { + "default": true, + "description": "Enables changeTypeSignature plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.class.codeActionsOn": { + "default": true, + "description": "Enables class code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.class.codeLensOn": { + "default": true, + "description": "Enables class code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.diff": { + "default": true, + "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.exception": { + "default": false, + "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.globalOn": { + "default": true, + "description": "Enables eval plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fields.globalOn": { + "default": true, + "description": "Enables explicit-fields plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fixity.globalOn": { + "default": true, + "description": "Enables explicit-fixity plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.fourmolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.gadt.globalOn": { + "default": true, + "description": "Enables gadt plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-bindings.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-bindings plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-fill-holes plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-imports-exports plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-type-signatures plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.autoExtendOn": { + "default": true, + "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.snippetsOn": { + "default": true, + "markdownDescription": "Inserts snippets when using code completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.globalOn": { + "default": true, + "description": "Enables ghcide-completions plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols hover", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols symbols", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-type-lenses.config.mode": { + "default": "always", + "description": "Control how type lenses are shown", + "enum": [ + "always", + "exported", + "diagnostics" + ], + "enumDescriptions": [ + "Always displays type lenses of global bindings", + "Only display type lenses of exported global bindings", + "Follows error messages produced by GHC about missing signatures" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.ghcide-type-lenses.globalOn": { + "default": true, + "description": "Enables ghcide-type-lenses plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.codeActionsOn": { + "default": true, + "description": "Enables hlint code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.config.flags": { + "default": [], + "markdownDescription": "Flags used by hlint", + "scope": "resource", + "type": "array" + }, + "haskell.plugin.hlint.diagnosticsOn": { + "default": true, + "description": "Enables hlint diagnostics", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeActionsOn": { + "default": true, + "description": "Enables importLens code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeLensOn": { + "default": true, + "description": "Enables importLens code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.moduleName.globalOn": { + "default": true, + "description": "Enables moduleName plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ormolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.overloaded-record-dot.globalOn": { + "default": true, + "description": "Enables overloaded-record-dot plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-completion.globalOn": { + "default": true, + "description": "Enables pragmas-completion plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-disable.globalOn": { + "default": true, + "description": "Enables pragmas-disable plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-suggest.globalOn": { + "default": true, + "description": "Enables pragmas-suggest plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.qualifyImportedNames.globalOn": { + "default": true, + "description": "Enables qualifyImportedNames plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.rename.config.crossModule": { + "default": false, + "markdownDescription": "Enable experimental cross-module renaming", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.rename.globalOn": { + "default": true, + "description": "Enables rename plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.retrie.globalOn": { + "default": true, + "description": "Enables retrie plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.semanticTokens.globalOn": { + "default": false, + "description": "Enables semanticTokens plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.splice.globalOn": { + "default": true, + "description": "Enables splice plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.stan.globalOn": { + "default": false, + "description": "Enables stan plugin", + "scope": "resource", + "type": "boolean" + } +} diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json new file mode 100644 index 0000000000..96f2567cec --- /dev/null +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -0,0 +1,127 @@ +{ + "checkParents": "CheckOnSave", + "checkProject": true, + "formattingProvider": "ormolu", + "maxCompletions": 40, + "plugin": { + "alternateNumberFormat": { + "globalOn": true + }, + "cabal": { + "codeActionsOn": true, + "completionOn": true + }, + "callHierarchy": { + "globalOn": true + }, + "changeTypeSignature": { + "globalOn": true + }, + "class": { + "codeActionsOn": true, + "codeLensOn": true + }, + "eval": { + "config": { + "diff": true, + "exception": false + }, + "globalOn": true + }, + "explicit-fields": { + "globalOn": true + }, + "explicit-fixity": { + "globalOn": true + }, + "fourmolu": { + "config": { + "external": false + } + }, + "gadt": { + "globalOn": true + }, + "ghcide-code-actions-bindings": { + "globalOn": true + }, + "ghcide-code-actions-fill-holes": { + "globalOn": true + }, + "ghcide-code-actions-imports-exports": { + "globalOn": true + }, + "ghcide-code-actions-type-signatures": { + "globalOn": true + }, + "ghcide-completions": { + "config": { + "autoExtendOn": true, + "snippetsOn": true + }, + "globalOn": true + }, + "ghcide-hover-and-symbols": { + "hoverOn": true, + "symbolsOn": true + }, + "ghcide-type-lenses": { + "config": { + "mode": "always" + }, + "globalOn": true + }, + "hlint": { + "codeActionsOn": true, + "config": { + "flags": [] + }, + "diagnosticsOn": true + }, + "importLens": { + "codeActionsOn": true, + "codeLensOn": true + }, + "moduleName": { + "globalOn": true + }, + "ormolu": { + "config": { + "external": false + } + }, + "overloaded-record-dot": { + "globalOn": true + }, + "pragmas-completion": { + "globalOn": true + }, + "pragmas-disable": { + "globalOn": true + }, + "pragmas-suggest": { + "globalOn": true + }, + "qualifyImportedNames": { + "globalOn": true + }, + "rename": { + "config": { + "crossModule": false + }, + "globalOn": true + }, + "retrie": { + "globalOn": true + }, + "semanticTokens": { + "globalOn": false + }, + "splice": { + "globalOn": true + }, + "stan": { + "globalOn": false + } + } +} diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json new file mode 100644 index 0000000000..349b07571d --- /dev/null +++ b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json @@ -0,0 +1,270 @@ +{ + "haskell.plugin.alternateNumberFormat.globalOn": { + "default": true, + "description": "Enables alternateNumberFormat plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.codeActionsOn": { + "default": true, + "description": "Enables cabal code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.completionOn": { + "default": true, + "description": "Enables cabal completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.callHierarchy.globalOn": { + "default": true, + "description": "Enables callHierarchy plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.changeTypeSignature.globalOn": { + "default": true, + "description": "Enables changeTypeSignature plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.class.codeActionsOn": { + "default": true, + "description": "Enables class code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.class.codeLensOn": { + "default": true, + "description": "Enables class code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.diff": { + "default": true, + "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.exception": { + "default": false, + "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.globalOn": { + "default": true, + "description": "Enables eval plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fields.globalOn": { + "default": true, + "description": "Enables explicit-fields plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fixity.globalOn": { + "default": true, + "description": "Enables explicit-fixity plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.fourmolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.gadt.globalOn": { + "default": true, + "description": "Enables gadt plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-bindings.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-bindings plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-fill-holes plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-imports-exports plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-type-signatures plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.autoExtendOn": { + "default": true, + "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.snippetsOn": { + "default": true, + "markdownDescription": "Inserts snippets when using code completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.globalOn": { + "default": true, + "description": "Enables ghcide-completions plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols hover", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols symbols", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-type-lenses.config.mode": { + "default": "always", + "description": "Control how type lenses are shown", + "enum": [ + "always", + "exported", + "diagnostics" + ], + "enumDescriptions": [ + "Always displays type lenses of global bindings", + "Only display type lenses of exported global bindings", + "Follows error messages produced by GHC about missing signatures" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.ghcide-type-lenses.globalOn": { + "default": true, + "description": "Enables ghcide-type-lenses plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.codeActionsOn": { + "default": true, + "description": "Enables hlint code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.config.flags": { + "default": [], + "markdownDescription": "Flags used by hlint", + "scope": "resource", + "type": "array" + }, + "haskell.plugin.hlint.diagnosticsOn": { + "default": true, + "description": "Enables hlint diagnostics", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeActionsOn": { + "default": true, + "description": "Enables importLens code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeLensOn": { + "default": true, + "description": "Enables importLens code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.moduleName.globalOn": { + "default": true, + "description": "Enables moduleName plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ormolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.overloaded-record-dot.globalOn": { + "default": true, + "description": "Enables overloaded-record-dot plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-completion.globalOn": { + "default": true, + "description": "Enables pragmas-completion plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-disable.globalOn": { + "default": true, + "description": "Enables pragmas-disable plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-suggest.globalOn": { + "default": true, + "description": "Enables pragmas-suggest plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.qualifyImportedNames.globalOn": { + "default": true, + "description": "Enables qualifyImportedNames plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.rename.config.crossModule": { + "default": false, + "markdownDescription": "Enable experimental cross-module renaming", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.rename.globalOn": { + "default": true, + "description": "Enables rename plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.retrie.globalOn": { + "default": true, + "description": "Enables retrie plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.semanticTokens.globalOn": { + "default": false, + "description": "Enables semanticTokens plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.splice.globalOn": { + "default": true, + "description": "Enables splice plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.stan.globalOn": { + "default": false, + "description": "Enables stan plugin", + "scope": "resource", + "type": "boolean" + } +} diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json new file mode 100644 index 0000000000..31c5a79400 --- /dev/null +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -0,0 +1,89 @@ +{ + "checkParents": "CheckOnSave", + "checkProject": true, + "formattingProvider": "ormolu", + "maxCompletions": 40, + "plugin": { + "alternateNumberFormat": { + "globalOn": true + }, + "cabal": { + "codeActionsOn": true, + "completionOn": true + }, + "callHierarchy": { + "globalOn": true + }, + "changeTypeSignature": { + "globalOn": true + }, + "eval": { + "config": { + "diff": true, + "exception": false + }, + "globalOn": true + }, + "explicit-fields": { + "globalOn": true + }, + "explicit-fixity": { + "globalOn": true + }, + "fourmolu": { + "config": { + "external": false + } + }, + "ghcide-completions": { + "config": { + "autoExtendOn": true, + "snippetsOn": true + }, + "globalOn": true + }, + "ghcide-hover-and-symbols": { + "hoverOn": true, + "symbolsOn": true + }, + "ghcide-type-lenses": { + "config": { + "mode": "always" + }, + "globalOn": true + }, + "importLens": { + "codeActionsOn": true, + "codeLensOn": true + }, + "moduleName": { + "globalOn": true + }, + "ormolu": { + "config": { + "external": false + } + }, + "overloaded-record-dot": { + "globalOn": true + }, + "pragmas-completion": { + "globalOn": true + }, + "pragmas-disable": { + "globalOn": true + }, + "pragmas-suggest": { + "globalOn": true + }, + "qualifyImportedNames": { + "globalOn": true + }, + "semanticTokens": { + "globalOn": false + }, + "stan": { + "globalOn": false + } + } +} diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json new file mode 100644 index 0000000000..b01b0f0189 --- /dev/null +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -0,0 +1,186 @@ +{ + "haskell.plugin.alternateNumberFormat.globalOn": { + "default": true, + "description": "Enables alternateNumberFormat plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.codeActionsOn": { + "default": true, + "description": "Enables cabal code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.completionOn": { + "default": true, + "description": "Enables cabal completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.callHierarchy.globalOn": { + "default": true, + "description": "Enables callHierarchy plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.changeTypeSignature.globalOn": { + "default": true, + "description": "Enables changeTypeSignature plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.diff": { + "default": true, + "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.exception": { + "default": false, + "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.globalOn": { + "default": true, + "description": "Enables eval plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fields.globalOn": { + "default": true, + "description": "Enables explicit-fields plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fixity.globalOn": { + "default": true, + "description": "Enables explicit-fixity plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.fourmolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.autoExtendOn": { + "default": true, + "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.snippetsOn": { + "default": true, + "markdownDescription": "Inserts snippets when using code completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.globalOn": { + "default": true, + "description": "Enables ghcide-completions plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols hover", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols symbols", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-type-lenses.config.mode": { + "default": "always", + "description": "Control how type lenses are shown", + "enum": [ + "always", + "exported", + "diagnostics" + ], + "enumDescriptions": [ + "Always displays type lenses of global bindings", + "Only display type lenses of exported global bindings", + "Follows error messages produced by GHC about missing signatures" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.ghcide-type-lenses.globalOn": { + "default": true, + "description": "Enables ghcide-type-lenses plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeActionsOn": { + "default": true, + "description": "Enables importLens code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeLensOn": { + "default": true, + "description": "Enables importLens code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.moduleName.globalOn": { + "default": true, + "description": "Enables moduleName plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ormolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.overloaded-record-dot.globalOn": { + "default": true, + "description": "Enables overloaded-record-dot plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-completion.globalOn": { + "default": true, + "description": "Enables pragmas-completion plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-disable.globalOn": { + "default": true, + "description": "Enables pragmas-disable plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-suggest.globalOn": { + "default": true, + "description": "Enables pragmas-suggest plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.qualifyImportedNames.globalOn": { + "default": true, + "description": "Enables qualifyImportedNames plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.semanticTokens.globalOn": { + "default": false, + "description": "Enables semanticTokens plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.stan.globalOn": { + "default": false, + "description": "Enables stan plugin", + "scope": "resource", + "type": "boolean" + } +} From fe0be7cfcdd5ae79aba1ffe8614f081c72b63657 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 12 Jan 2024 16:47:28 +0800 Subject: [PATCH 20/24] fix config generation scheme test --- config.vscode | 886 ++++++++++++++++++ .../schema/ghc92/default-config.golden.json | 13 + .../ghc92/vscode-extension-schema.golden.json | 616 ++++++++++++ .../schema/ghc94/default-config.golden.json | 13 + .../ghc94/vscode-extension-schema.golden.json | 616 ++++++++++++ .../schema/ghc96/default-config.golden.json | 13 + .../ghc96/vscode-extension-schema.golden.json | 616 ++++++++++++ .../schema/ghc98/default-config.golden.json | 13 + .../ghc98/vscode-extension-schema.golden.json | 616 ++++++++++++ 9 files changed, 3402 insertions(+) create mode 100644 config.vscode diff --git a/config.vscode b/config.vscode new file mode 100644 index 0000000000..535561ef70 --- /dev/null +++ b/config.vscode @@ -0,0 +1,886 @@ +{ + "haskell.plugin.alternateNumberFormat.globalOn": { + "default": true, + "description": "Enables alternateNumberFormat plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.codeActionsOn": { + "default": true, + "description": "Enables cabal code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.completionOn": { + "default": true, + "description": "Enables cabal completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.callHierarchy.globalOn": { + "default": true, + "description": "Enables callHierarchy plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.changeTypeSignature.globalOn": { + "default": true, + "description": "Enables changeTypeSignature plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.class.codeActionsOn": { + "default": true, + "description": "Enables class code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.class.codeLensOn": { + "default": true, + "description": "Enables class code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.diff": { + "default": true, + "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.exception": { + "default": false, + "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.globalOn": { + "default": true, + "description": "Enables eval plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fields.globalOn": { + "default": true, + "description": "Enables explicit-fields plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fixity.globalOn": { + "default": true, + "description": "Enables explicit-fixity plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.fourmolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.gadt.globalOn": { + "default": true, + "description": "Enables gadt plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-bindings.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-bindings plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-fill-holes plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-imports-exports plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-type-signatures plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.autoExtendOn": { + "default": true, + "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.snippetsOn": { + "default": true, + "markdownDescription": "Inserts snippets when using code completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.globalOn": { + "default": true, + "description": "Enables ghcide-completions plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols hover", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols symbols", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-type-lenses.config.mode": { + "default": "always", + "description": "Control how type lenses are shown", + "enum": [ + "always", + "exported", + "diagnostics" + ], + "enumDescriptions": [ + "Always displays type lenses of global bindings", + "Only display type lenses of exported global bindings", + "Follows error messages produced by GHC about missing signatures" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.ghcide-type-lenses.globalOn": { + "default": true, + "description": "Enables ghcide-type-lenses plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.codeActionsOn": { + "default": true, + "description": "Enables hlint code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.config.flags": { + "default": [], + "markdownDescription": "Flags used by hlint", + "scope": "resource", + "type": "array" + }, + "haskell.plugin.hlint.diagnosticsOn": { + "default": true, + "description": "Enables hlint diagnostics", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeActionsOn": { + "default": true, + "description": "Enables importLens code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeLensOn": { + "default": true, + "description": "Enables importLens code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.moduleName.globalOn": { + "default": true, + "description": "Enables moduleName plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ormolu.config.external": { + "default": false, + "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.overloaded-record-dot.globalOn": { + "default": true, + "description": "Enables overloaded-record-dot plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-completion.globalOn": { + "default": true, + "description": "Enables pragmas-completion plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-disable.globalOn": { + "default": true, + "description": "Enables pragmas-disable plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-suggest.globalOn": { + "default": true, + "description": "Enables pragmas-suggest plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.qualifyImportedNames.globalOn": { + "default": true, + "description": "Enables qualifyImportedNames plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.rename.config.crossModule": { + "default": false, + "markdownDescription": "Enable experimental cross-module renaming", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.rename.globalOn": { + "default": true, + "description": "Enables rename plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.retrie.globalOn": { + "default": true, + "description": "Enables retrie plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.semanticTokens.config.class": { + "default": "class", + "description": "LSP semantic token type to use for Class", + "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.classMethod": { + "default": "method", + "description": "LSP semantic token type to use for ClassMethod", + "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.dataCon": { + "default": "enumMember", + "description": "LSP semantic token type to use for DataCon", + "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.function": { + "default": "function", + "description": "LSP semantic token type to use for Function", + "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.patternSyn": { + "default": "macro", + "description": "LSP semantic token type to use for PatternSyn", + "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.recField": { + "default": "property", + "description": "LSP semantic token type to use for RecField", + "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.typeCon": { + "default": "enum", + "description": "LSP semantic token type to use for TypeCon", + "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.typeFamily": { + "default": "interface", + "description": "LSP semantic token type to use for TypeFamily", + "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.typeSyn": { + "default": "type", + "description": "LSP semantic token type to use for TypeSyn", + "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.typeVariable": { + "default": "typeParameter", + "description": "LSP semantic token type to use for TypeVariable", + "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.variable": { + "default": "variable", + "description": "LSP semantic token type to use for Variable", + "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", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.splice.globalOn": { + "default": true, + "description": "Enables splice plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.stan.globalOn": { + "default": false, + "description": "Enables stan plugin", + "scope": "resource", + "type": "boolean" + } +} diff --git a/test/testdata/schema/ghc92/default-config.golden.json b/test/testdata/schema/ghc92/default-config.golden.json index 949df9ed88..a2c8152792 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": { + "class": "class", + "classMethod": "method", + "dataCon": "enumMember", + "function": "function", + "patternSyn": "macro", + "recField": "property", + "typeCon": "enum", + "typeFamily": "interface", + "typeSyn": "type", + "typeVariable": "typeParameter", + "variable": "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..89bb85e57e 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.class": { + "default": "class", + "description": "LSP semantic token type to use for Class", + "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.classMethod": { + "default": "method", + "description": "LSP semantic token type to use for ClassMethod", + "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.dataCon": { + "default": "enumMember", + "description": "LSP semantic token type to use for DataCon", + "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.function": { + "default": "function", + "description": "LSP semantic token type to use for Function", + "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.patternSyn": { + "default": "macro", + "description": "LSP semantic token type to use for PatternSyn", + "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.recField": { + "default": "property", + "description": "LSP semantic token type to use for RecField", + "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.typeCon": { + "default": "enum", + "description": "LSP semantic token type to use for TypeCon", + "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.typeFamily": { + "default": "interface", + "description": "LSP semantic token type to use for TypeFamily", + "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.typeSyn": { + "default": "type", + "description": "LSP semantic token type to use for TypeSyn", + "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.typeVariable": { + "default": "typeParameter", + "description": "LSP semantic token type to use for TypeVariable", + "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.variable": { + "default": "variable", + "description": "LSP semantic token type to use for Variable", + "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..7e8c10ac8a 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": { + "class": "class", + "classMethod": "method", + "dataCon": "enumMember", + "function": "function", + "patternSyn": "macro", + "recField": "property", + "typeCon": "enum", + "typeFamily": "interface", + "typeSyn": "type", + "typeVariable": "typeParameter", + "variable": "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..535561ef70 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.class": { + "default": "class", + "description": "LSP semantic token type to use for Class", + "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.classMethod": { + "default": "method", + "description": "LSP semantic token type to use for ClassMethod", + "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.dataCon": { + "default": "enumMember", + "description": "LSP semantic token type to use for DataCon", + "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.function": { + "default": "function", + "description": "LSP semantic token type to use for Function", + "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.patternSyn": { + "default": "macro", + "description": "LSP semantic token type to use for PatternSyn", + "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.recField": { + "default": "property", + "description": "LSP semantic token type to use for RecField", + "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.typeCon": { + "default": "enum", + "description": "LSP semantic token type to use for TypeCon", + "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.typeFamily": { + "default": "interface", + "description": "LSP semantic token type to use for TypeFamily", + "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.typeSyn": { + "default": "type", + "description": "LSP semantic token type to use for TypeSyn", + "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.typeVariable": { + "default": "typeParameter", + "description": "LSP semantic token type to use for TypeVariable", + "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.variable": { + "default": "variable", + "description": "LSP semantic token type to use for Variable", + "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..7e8c10ac8a 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": { + "class": "class", + "classMethod": "method", + "dataCon": "enumMember", + "function": "function", + "patternSyn": "macro", + "recField": "property", + "typeCon": "enum", + "typeFamily": "interface", + "typeSyn": "type", + "typeVariable": "typeParameter", + "variable": "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..535561ef70 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.class": { + "default": "class", + "description": "LSP semantic token type to use for Class", + "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.classMethod": { + "default": "method", + "description": "LSP semantic token type to use for ClassMethod", + "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.dataCon": { + "default": "enumMember", + "description": "LSP semantic token type to use for DataCon", + "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.function": { + "default": "function", + "description": "LSP semantic token type to use for Function", + "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.patternSyn": { + "default": "macro", + "description": "LSP semantic token type to use for PatternSyn", + "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.recField": { + "default": "property", + "description": "LSP semantic token type to use for RecField", + "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.typeCon": { + "default": "enum", + "description": "LSP semantic token type to use for TypeCon", + "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.typeFamily": { + "default": "interface", + "description": "LSP semantic token type to use for TypeFamily", + "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.typeSyn": { + "default": "type", + "description": "LSP semantic token type to use for TypeSyn", + "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.typeVariable": { + "default": "typeParameter", + "description": "LSP semantic token type to use for TypeVariable", + "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.variable": { + "default": "variable", + "description": "LSP semantic token type to use for Variable", + "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..781ae4cf36 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": { + "class": "class", + "classMethod": "method", + "dataCon": "enumMember", + "function": "function", + "patternSyn": "macro", + "recField": "property", + "typeCon": "enum", + "typeFamily": "interface", + "typeSyn": "type", + "typeVariable": "typeParameter", + "variable": "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..44da340900 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.class": { + "default": "class", + "description": "LSP semantic token type to use for Class", + "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.classMethod": { + "default": "method", + "description": "LSP semantic token type to use for ClassMethod", + "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.dataCon": { + "default": "enumMember", + "description": "LSP semantic token type to use for DataCon", + "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.function": { + "default": "function", + "description": "LSP semantic token type to use for Function", + "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.patternSyn": { + "default": "macro", + "description": "LSP semantic token type to use for PatternSyn", + "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.recField": { + "default": "property", + "description": "LSP semantic token type to use for RecField", + "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.typeCon": { + "default": "enum", + "description": "LSP semantic token type to use for TypeCon", + "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.typeFamily": { + "default": "interface", + "description": "LSP semantic token type to use for TypeFamily", + "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.typeSyn": { + "default": "type", + "description": "LSP semantic token type to use for TypeSyn", + "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.typeVariable": { + "default": "typeParameter", + "description": "LSP semantic token type to use for TypeVariable", + "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.variable": { + "default": "variable", + "description": "LSP semantic token type to use for Variable", + "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", From dfc458bff33fef7de568ee5d8650bff701a3c1ca Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 12 Jan 2024 22:05:13 +0800 Subject: [PATCH 21/24] ajust names for semantic tokens --- .../src/Ide/Plugin/SemanticTokens/Mappings.hs | 44 +- .../Plugin/SemanticTokens/SemanticConfig.hs | 24 +- .../src/Ide/Plugin/SemanticTokens/Types.hs | 55 +- .../hls-semantic-tokens-plugin/test/Main.hs | 4 +- .../test/testdata/T1.expected | 58 +- .../test/testdata/TClass.expected | 2 +- .../testdata/TClassImportedDeriving.expected | 4 +- .../test/testdata/TDataFamily.expected | 14 +- .../test/testdata/TDataType.expected | 6 +- .../test/testdata/TDatatypeImported.expected | 2 +- .../test/testdata/TFunctionLet.expected | 2 +- .../test/testdata/TFunctionLocal.expected | 4 +- .../test/testdata/TGADT.expected | 14 +- .../TInstanceClassMethodBind.expected | 8 +- .../test/testdata/TPatternMatch.expected | 2 +- .../test/testdata/TPatternSyn.expected | 1 - .../test/testdata/TPatternSynonym.expected | 1 + .../{TPatternSyn.hs => TPatternSynonym.hs} | 2 +- .../test/testdata/TRecord.expected | 8 +- .../test/testdata/TTypefamily.expected | 6 +- .../test/testdata/TValBind.expected | 2 +- .../schema/ghc92/default-config.golden.json | 10 +- .../ghc92/vscode-extension-schema.golden.json | 538 +++++++++--------- .../schema/ghc94/default-config.golden.json | 10 +- .../ghc94/vscode-extension-schema.golden.json | 538 +++++++++--------- .../schema/ghc96/default-config.golden.json | 10 +- .../ghc96/vscode-extension-schema.golden.json | 538 +++++++++--------- .../schema/ghc98/default-config.golden.json | 10 +- .../ghc98/vscode-extension-schema.golden.json | 538 +++++++++--------- 29 files changed, 1232 insertions(+), 1223 deletions(-) delete mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSyn.expected create mode 100644 plugins/hls-semantic-tokens-plugin/test/testdata/TPatternSynonym.expected rename plugins/hls-semantic-tokens-plugin/test/testdata/{TPatternSyn.hs => TPatternSynonym.hs} (64%) 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 1d53d7ac15..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 @@ -34,17 +34,17 @@ import Language.LSP.VFS hiding (line) -- | map from haskell semantic token type to LSP default token type toLspTokenType :: SemanticTokensConfig -> HsSemanticTokenType -> SemanticTokenTypes toLspTokenType conf tk = case tk of - TFunction -> stFunction conf - TVariable -> stVariable conf - TClassMethod -> stClassMethod conf - TTypeVariable -> stTypeVariable conf - TDataCon -> stDataCon conf - TClass -> stClass conf - TTypeCon -> stTypeCon conf - TTypeSyn -> stTypeSyn conf - TTypeFamily -> stTypeFamily conf - TRecField -> stRecField conf - TPatternSyn -> stPatternSyn conf + 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 @@ -63,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 @@ -139,16 +139,16 @@ 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 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 index 7a6eba2015..a29265ff7b 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs @@ -19,17 +19,32 @@ 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" <>) --- lspTokenTypeDescription :: [(SemanticTokenTypes, String)] type LspTokenTypeDescriptions = [(SemanticTokenTypes, T.Text)] lspTokenTypeDescriptions :: LspTokenTypeDescriptions lspTokenTypeDescriptions = map ( \x -> - (x, "LSP Semantic Token Type:" <> toEnumBaseType x) + (x, "LSP Semantic Token Type: " <> toEnumBaseType x) ) $ S.toList knownValues @@ -64,8 +79,7 @@ mkSemanticConfigFunctions = do let pid = mkName "pid" let semanticConfigPropertiesName = mkName "semanticConfigProperties" let useSemanticConfigActionName = mkName "useSemanticConfigAction" - let - allLabels = map (LabelE . lowerFirst) allHsTokenNameStrings + let allLabels = map (LabelE . lowerFirst) allHsTokenNameStrings allFieldsNames = map (mkName . toConfigName) allHsTokenNameStrings allVariableNames = map (mkName . ("_variable_" <>) . toConfigName) allHsTokenNameStrings -- <- useSemanticConfigAction label pid config @@ -85,7 +99,7 @@ mkSemanticConfigFunctions = do nameAndDescList <- mapM ( \(lb, x) -> do - desc <- [|"LSP semantic token type to use for " <> T.pack (drop 1 $ show x)|] + desc <- [|"LSP semantic token type to use for " <> docName x|] lspToken <- [|toLspTokenType def x|] return $ TupE [Just lb, Just desc, Just lspToken] ) 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 80b95a11ae..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,23 +1,16 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveLift #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} - {-# LANGUAGE InstanceSigs #-} - {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} - - +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StrictData #-} - {-# LANGUAGE TypeFamilies #-} - -{-# LANGUAGE DeriveLift #-} -{-# LANGUAGE ScopedTypeVariables #-} - module Ide.Plugin.SemanticTokens.Types where import Control.DeepSeq (NFData (rnf), rwhnf) @@ -41,50 +34,52 @@ import Language.Haskell.TH.Syntax (Lift) 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 + | 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 - , stDataCon = SemanticTokenTypes_EnumMember + , stDataConstructor = SemanticTokenTypes_EnumMember , stTypeVariable = SemanticTokenTypes_TypeParameter , stClassMethod = SemanticTokenTypes_Method -- pattern syn is like a limited version of macro of constructing a term - , stPatternSyn = SemanticTokenTypes_Macro + , 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 - , stTypeCon = SemanticTokenTypes_Enum + , stTypeConstructor = SemanticTokenTypes_Enum , stClass = SemanticTokenTypes_Class - , stTypeSyn = SemanticTokenTypes_Type + , stTypeSynonym = SemanticTokenTypes_Type , stTypeFamily = SemanticTokenTypes_Interface - , stRecField = SemanticTokenTypes_Property + , 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 - , stDataCon :: !SemanticTokenTypes - , stTypeVariable :: !SemanticTokenTypes - , stClassMethod :: !SemanticTokenTypes - , stPatternSyn :: !SemanticTokenTypes - , stTypeCon :: !SemanticTokenTypes - , stClass :: !SemanticTokenTypes - , stTypeSyn :: !SemanticTokenTypes - , stTypeFamily :: !SemanticTokenTypes - , stRecField :: !SemanticTokenTypes + { 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) diff --git a/plugins/hls-semantic-tokens-plugin/test/Main.hs b/plugins/hls-semantic-tokens-plugin/test/Main.hs index 5590d6841c..1bc43462a5 100644 --- a/plugins/hls-semantic-tokens-plugin/test/Main.hs +++ b/plugins/hls-semantic-tokens-plugin/test/Main.hs @@ -168,7 +168,7 @@ semanticTokensTests = 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" @@ -192,7 +192,7 @@ semanticTokensTests = _ -> error "No tokens found" liftIO $ 1 @?= 1, goldenWithSemanticTokensWithDefaultConfig "mixed constancy test result generated from one ghc version" "T1", - goldenWithSemanticTokensWithDefaultConfig "pattern bind" "TPatternSyn", + goldenWithSemanticTokensWithDefaultConfig "pattern bind" "TPatternSynonym", goldenWithSemanticTokensWithDefaultConfig "type family" "TTypefamily", goldenWithSemanticTokensWithDefaultConfig "TUnicodeSyntax" "TUnicodeSyntax" ] 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/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/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/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 a2c8152792..6a37fa87d9 100644 --- a/test/testdata/schema/ghc92/default-config.golden.json +++ b/test/testdata/schema/ghc92/default-config.golden.json @@ -118,13 +118,13 @@ "config": { "class": "class", "classMethod": "method", - "dataCon": "enumMember", + "dataConstructor": "enumMember", "function": "function", - "patternSyn": "macro", - "recField": "property", - "typeCon": "enum", + "patternSynonym": "macro", + "recordField": "property", + "typeConstructor": "enum", "typeFamily": "interface", - "typeSyn": "type", + "typeSynonym": "type", "typeVariable": "typeParameter", "variable": "variable" }, diff --git a/test/testdata/schema/ghc92/vscode-extension-schema.golden.json b/test/testdata/schema/ghc92/vscode-extension-schema.golden.json index 89bb85e57e..ff549c8936 100644 --- a/test/testdata/schema/ghc92/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc92/vscode-extension-schema.golden.json @@ -251,7 +251,7 @@ }, "haskell.plugin.semanticTokens.config.class": { "default": "class", - "description": "LSP semantic token type to use for Class", + "description": "LSP semantic token type to use for typeclasses", "enum": [ "namespace", "type", @@ -278,36 +278,36 @@ "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" + "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.classMethod": { "default": "method", - "description": "LSP semantic token type to use for ClassMethod", + "description": "LSP semantic token type to use for typeclass methods", "enum": [ "namespace", "type", @@ -334,36 +334,36 @@ "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" + "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.dataCon": { + "haskell.plugin.semanticTokens.config.dataConstructor": { "default": "enumMember", - "description": "LSP semantic token type to use for DataCon", + "description": "LSP semantic token type to use for data constructors", "enum": [ "namespace", "type", @@ -390,36 +390,36 @@ "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" + "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.function": { "default": "function", - "description": "LSP semantic token type to use for Function", + "description": "LSP semantic token type to use for functions", "enum": [ "namespace", "type", @@ -446,36 +446,36 @@ "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" + "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.patternSyn": { + "haskell.plugin.semanticTokens.config.patternSynonym": { "default": "macro", - "description": "LSP semantic token type to use for PatternSyn", + "description": "LSP semantic token type to use for pattern synonyms", "enum": [ "namespace", "type", @@ -502,36 +502,36 @@ "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" + "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.recField": { + "haskell.plugin.semanticTokens.config.recordField": { "default": "property", - "description": "LSP semantic token type to use for RecField", + "description": "LSP semantic token type to use for record fields", "enum": [ "namespace", "type", @@ -558,36 +558,36 @@ "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" + "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.typeCon": { + "haskell.plugin.semanticTokens.config.typeConstructor": { "default": "enum", - "description": "LSP semantic token type to use for TypeCon", + "description": "LSP semantic token type to use for type constructors", "enum": [ "namespace", "type", @@ -614,36 +614,36 @@ "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" + "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.typeFamily": { "default": "interface", - "description": "LSP semantic token type to use for TypeFamily", + "description": "LSP semantic token type to use for type families", "enum": [ "namespace", "type", @@ -670,36 +670,36 @@ "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" + "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.typeSyn": { + "haskell.plugin.semanticTokens.config.typeSynonym": { "default": "type", - "description": "LSP semantic token type to use for TypeSyn", + "description": "LSP semantic token type to use for type synonyms", "enum": [ "namespace", "type", @@ -726,36 +726,36 @@ "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" + "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.typeVariable": { "default": "typeParameter", - "description": "LSP semantic token type to use for TypeVariable", + "description": "LSP semantic token type to use for type variables", "enum": [ "namespace", "type", @@ -782,36 +782,36 @@ "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" + "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.variable": { "default": "variable", - "description": "LSP semantic token type to use for Variable", + "description": "LSP semantic token type to use for variables", "enum": [ "namespace", "type", @@ -838,29 +838,29 @@ "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" + "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" diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json index 7e8c10ac8a..2ff8dffff1 100644 --- a/test/testdata/schema/ghc94/default-config.golden.json +++ b/test/testdata/schema/ghc94/default-config.golden.json @@ -118,13 +118,13 @@ "config": { "class": "class", "classMethod": "method", - "dataCon": "enumMember", + "dataConstructor": "enumMember", "function": "function", - "patternSyn": "macro", - "recField": "property", - "typeCon": "enum", + "patternSynonym": "macro", + "recordField": "property", + "typeConstructor": "enum", "typeFamily": "interface", - "typeSyn": "type", + "typeSynonym": "type", "typeVariable": "typeParameter", "variable": "variable" }, diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json index 535561ef70..509448dff7 100644 --- a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json @@ -251,7 +251,7 @@ }, "haskell.plugin.semanticTokens.config.class": { "default": "class", - "description": "LSP semantic token type to use for Class", + "description": "LSP semantic token type to use for typeclasses", "enum": [ "namespace", "type", @@ -278,36 +278,36 @@ "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" + "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.classMethod": { "default": "method", - "description": "LSP semantic token type to use for ClassMethod", + "description": "LSP semantic token type to use for typeclass methods", "enum": [ "namespace", "type", @@ -334,36 +334,36 @@ "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" + "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.dataCon": { + "haskell.plugin.semanticTokens.config.dataConstructor": { "default": "enumMember", - "description": "LSP semantic token type to use for DataCon", + "description": "LSP semantic token type to use for data constructors", "enum": [ "namespace", "type", @@ -390,36 +390,36 @@ "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" + "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.function": { "default": "function", - "description": "LSP semantic token type to use for Function", + "description": "LSP semantic token type to use for functions", "enum": [ "namespace", "type", @@ -446,36 +446,36 @@ "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" + "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.patternSyn": { + "haskell.plugin.semanticTokens.config.patternSynonym": { "default": "macro", - "description": "LSP semantic token type to use for PatternSyn", + "description": "LSP semantic token type to use for pattern synonyms", "enum": [ "namespace", "type", @@ -502,36 +502,36 @@ "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" + "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.recField": { + "haskell.plugin.semanticTokens.config.recordField": { "default": "property", - "description": "LSP semantic token type to use for RecField", + "description": "LSP semantic token type to use for record fields", "enum": [ "namespace", "type", @@ -558,36 +558,36 @@ "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" + "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.typeCon": { + "haskell.plugin.semanticTokens.config.typeConstructor": { "default": "enum", - "description": "LSP semantic token type to use for TypeCon", + "description": "LSP semantic token type to use for type constructors", "enum": [ "namespace", "type", @@ -614,36 +614,36 @@ "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" + "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.typeFamily": { "default": "interface", - "description": "LSP semantic token type to use for TypeFamily", + "description": "LSP semantic token type to use for type families", "enum": [ "namespace", "type", @@ -670,36 +670,36 @@ "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" + "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.typeSyn": { + "haskell.plugin.semanticTokens.config.typeSynonym": { "default": "type", - "description": "LSP semantic token type to use for TypeSyn", + "description": "LSP semantic token type to use for type synonyms", "enum": [ "namespace", "type", @@ -726,36 +726,36 @@ "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" + "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.typeVariable": { "default": "typeParameter", - "description": "LSP semantic token type to use for TypeVariable", + "description": "LSP semantic token type to use for type variables", "enum": [ "namespace", "type", @@ -782,36 +782,36 @@ "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" + "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.variable": { "default": "variable", - "description": "LSP semantic token type to use for Variable", + "description": "LSP semantic token type to use for variables", "enum": [ "namespace", "type", @@ -838,29 +838,29 @@ "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" + "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" diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json index 7e8c10ac8a..2ff8dffff1 100644 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -118,13 +118,13 @@ "config": { "class": "class", "classMethod": "method", - "dataCon": "enumMember", + "dataConstructor": "enumMember", "function": "function", - "patternSyn": "macro", - "recField": "property", - "typeCon": "enum", + "patternSynonym": "macro", + "recordField": "property", + "typeConstructor": "enum", "typeFamily": "interface", - "typeSyn": "type", + "typeSynonym": "type", "typeVariable": "typeParameter", "variable": "variable" }, diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json index 535561ef70..509448dff7 100644 --- a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json @@ -251,7 +251,7 @@ }, "haskell.plugin.semanticTokens.config.class": { "default": "class", - "description": "LSP semantic token type to use for Class", + "description": "LSP semantic token type to use for typeclasses", "enum": [ "namespace", "type", @@ -278,36 +278,36 @@ "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" + "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.classMethod": { "default": "method", - "description": "LSP semantic token type to use for ClassMethod", + "description": "LSP semantic token type to use for typeclass methods", "enum": [ "namespace", "type", @@ -334,36 +334,36 @@ "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" + "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.dataCon": { + "haskell.plugin.semanticTokens.config.dataConstructor": { "default": "enumMember", - "description": "LSP semantic token type to use for DataCon", + "description": "LSP semantic token type to use for data constructors", "enum": [ "namespace", "type", @@ -390,36 +390,36 @@ "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" + "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.function": { "default": "function", - "description": "LSP semantic token type to use for Function", + "description": "LSP semantic token type to use for functions", "enum": [ "namespace", "type", @@ -446,36 +446,36 @@ "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" + "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.patternSyn": { + "haskell.plugin.semanticTokens.config.patternSynonym": { "default": "macro", - "description": "LSP semantic token type to use for PatternSyn", + "description": "LSP semantic token type to use for pattern synonyms", "enum": [ "namespace", "type", @@ -502,36 +502,36 @@ "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" + "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.recField": { + "haskell.plugin.semanticTokens.config.recordField": { "default": "property", - "description": "LSP semantic token type to use for RecField", + "description": "LSP semantic token type to use for record fields", "enum": [ "namespace", "type", @@ -558,36 +558,36 @@ "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" + "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.typeCon": { + "haskell.plugin.semanticTokens.config.typeConstructor": { "default": "enum", - "description": "LSP semantic token type to use for TypeCon", + "description": "LSP semantic token type to use for type constructors", "enum": [ "namespace", "type", @@ -614,36 +614,36 @@ "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" + "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.typeFamily": { "default": "interface", - "description": "LSP semantic token type to use for TypeFamily", + "description": "LSP semantic token type to use for type families", "enum": [ "namespace", "type", @@ -670,36 +670,36 @@ "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" + "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.typeSyn": { + "haskell.plugin.semanticTokens.config.typeSynonym": { "default": "type", - "description": "LSP semantic token type to use for TypeSyn", + "description": "LSP semantic token type to use for type synonyms", "enum": [ "namespace", "type", @@ -726,36 +726,36 @@ "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" + "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.typeVariable": { "default": "typeParameter", - "description": "LSP semantic token type to use for TypeVariable", + "description": "LSP semantic token type to use for type variables", "enum": [ "namespace", "type", @@ -782,36 +782,36 @@ "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" + "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.variable": { "default": "variable", - "description": "LSP semantic token type to use for Variable", + "description": "LSP semantic token type to use for variables", "enum": [ "namespace", "type", @@ -838,29 +838,29 @@ "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" + "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" diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json index 781ae4cf36..34224ce426 100644 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -83,13 +83,13 @@ "config": { "class": "class", "classMethod": "method", - "dataCon": "enumMember", + "dataConstructor": "enumMember", "function": "function", - "patternSyn": "macro", - "recField": "property", - "typeCon": "enum", + "patternSynonym": "macro", + "recordField": "property", + "typeConstructor": "enum", "typeFamily": "interface", - "typeSyn": "type", + "typeSynonym": "type", "typeVariable": "typeParameter", "variable": "variable" }, diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json index 44da340900..23b57e9b3c 100644 --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -173,7 +173,7 @@ }, "haskell.plugin.semanticTokens.config.class": { "default": "class", - "description": "LSP semantic token type to use for Class", + "description": "LSP semantic token type to use for typeclasses", "enum": [ "namespace", "type", @@ -200,36 +200,36 @@ "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" + "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.classMethod": { "default": "method", - "description": "LSP semantic token type to use for ClassMethod", + "description": "LSP semantic token type to use for typeclass methods", "enum": [ "namespace", "type", @@ -256,36 +256,36 @@ "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" + "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.dataCon": { + "haskell.plugin.semanticTokens.config.dataConstructor": { "default": "enumMember", - "description": "LSP semantic token type to use for DataCon", + "description": "LSP semantic token type to use for data constructors", "enum": [ "namespace", "type", @@ -312,36 +312,36 @@ "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" + "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.function": { "default": "function", - "description": "LSP semantic token type to use for Function", + "description": "LSP semantic token type to use for functions", "enum": [ "namespace", "type", @@ -368,36 +368,36 @@ "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" + "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.patternSyn": { + "haskell.plugin.semanticTokens.config.patternSynonym": { "default": "macro", - "description": "LSP semantic token type to use for PatternSyn", + "description": "LSP semantic token type to use for pattern synonyms", "enum": [ "namespace", "type", @@ -424,36 +424,36 @@ "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" + "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.recField": { + "haskell.plugin.semanticTokens.config.recordField": { "default": "property", - "description": "LSP semantic token type to use for RecField", + "description": "LSP semantic token type to use for record fields", "enum": [ "namespace", "type", @@ -480,36 +480,36 @@ "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" + "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.typeCon": { + "haskell.plugin.semanticTokens.config.typeConstructor": { "default": "enum", - "description": "LSP semantic token type to use for TypeCon", + "description": "LSP semantic token type to use for type constructors", "enum": [ "namespace", "type", @@ -536,36 +536,36 @@ "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" + "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.typeFamily": { "default": "interface", - "description": "LSP semantic token type to use for TypeFamily", + "description": "LSP semantic token type to use for type families", "enum": [ "namespace", "type", @@ -592,36 +592,36 @@ "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" + "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.typeSyn": { + "haskell.plugin.semanticTokens.config.typeSynonym": { "default": "type", - "description": "LSP semantic token type to use for TypeSyn", + "description": "LSP semantic token type to use for type synonyms", "enum": [ "namespace", "type", @@ -648,36 +648,36 @@ "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" + "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.typeVariable": { "default": "typeParameter", - "description": "LSP semantic token type to use for TypeVariable", + "description": "LSP semantic token type to use for type variables", "enum": [ "namespace", "type", @@ -704,36 +704,36 @@ "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" + "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.variable": { "default": "variable", - "description": "LSP semantic token type to use for Variable", + "description": "LSP semantic token type to use for variables", "enum": [ "namespace", "type", @@ -760,29 +760,29 @@ "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" + "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" From dca68758ad58b12827dda99fd3b9eb6045084516 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sat, 13 Jan 2024 23:22:53 +0800 Subject: [PATCH 22/24] add token suffix to token type configuration --- generate.bash | 4 +++ .../Plugin/SemanticTokens/SemanticConfig.hs | 2 +- .../hls-semantic-tokens-plugin/test/Main.hs | 2 +- .../schema/ghc92/default-config.golden.json | 22 +++++++------- .../ghc92/vscode-extension-schema.golden.json | 30 +++++++++---------- .../schema/ghc94/default-config.golden.json | 22 +++++++------- .../ghc94/vscode-extension-schema.golden.json | 30 +++++++++---------- .../schema/ghc96/default-config.golden.json | 22 +++++++------- .../ghc96/vscode-extension-schema.golden.json | 30 +++++++++---------- .../schema/ghc98/default-config.golden.json | 22 +++++++------- .../ghc98/vscode-extension-schema.golden.json | 30 +++++++++---------- 11 files changed, 110 insertions(+), 106 deletions(-) create mode 100644 generate.bash diff --git a/generate.bash b/generate.bash new file mode 100644 index 0000000000..531115710c --- /dev/null +++ b/generate.bash @@ -0,0 +1,4 @@ +ghcup set ghc 9.2.8; cabal clean; cabal test --test-option="-p /generate schema/" +ghcup set ghc 9.4.8; cabal clean; cabal test --test-option="-p /generate schema/" +ghcup set ghc 9.6.2; cabal clean; cabal test --test-option="-p /generate schema/" +ghcup set ghc 9.8.1; cabal clean; cabal test --test-option="-p /generate schema/" 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 index a29265ff7b..7afcc879da 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/SemanticConfig.hs @@ -79,7 +79,7 @@ mkSemanticConfigFunctions = do let pid = mkName "pid" let semanticConfigPropertiesName = mkName "semanticConfigProperties" let useSemanticConfigActionName = mkName "useSemanticConfigAction" - let allLabels = map (LabelE . lowerFirst) allHsTokenNameStrings + let allLabels = map (LabelE . (<> "Token"). lowerFirst) allHsTokenNameStrings allFieldsNames = map (mkName . toConfigName) allHsTokenNameStrings allVariableNames = map (mkName . ("_variable_" <>) . toConfigName) allHsTokenNameStrings -- <- useSemanticConfigAction label pid config diff --git a/plugins/hls-semantic-tokens-plugin/test/Main.hs b/plugins/hls-semantic-tokens-plugin/test/Main.hs index 1bc43462a5..4c9be25d66 100644 --- a/plugins/hls-semantic-tokens-plugin/test/Main.hs +++ b/plugins/hls-semantic-tokens-plugin/test/Main.hs @@ -141,7 +141,7 @@ 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 ["function" .= var] + let funcVar = object ["functionToken" .= var] var :: String var = "variable" do diff --git a/test/testdata/schema/ghc92/default-config.golden.json b/test/testdata/schema/ghc92/default-config.golden.json index 6a37fa87d9..d4e9e717b7 100644 --- a/test/testdata/schema/ghc92/default-config.golden.json +++ b/test/testdata/schema/ghc92/default-config.golden.json @@ -116,17 +116,17 @@ }, "semanticTokens": { "config": { - "class": "class", - "classMethod": "method", - "dataConstructor": "enumMember", - "function": "function", - "patternSynonym": "macro", - "recordField": "property", - "typeConstructor": "enum", - "typeFamily": "interface", - "typeSynonym": "type", - "typeVariable": "typeParameter", - "variable": "variable" + "classMethodToken": "method", + "classToken": "class", + "dataConstructorToken": "enumMember", + "functionToken": "function", + "patternSynonymToken": "macro", + "recordFieldToken": "property", + "typeConstructorToken": "enum", + "typeFamilyToken": "interface", + "typeSynonymToken": "type", + "typeVariableToken": "typeParameter", + "variableToken": "variable" }, "globalOn": false }, diff --git a/test/testdata/schema/ghc92/vscode-extension-schema.golden.json b/test/testdata/schema/ghc92/vscode-extension-schema.golden.json index ff549c8936..c063ad0b5a 100644 --- a/test/testdata/schema/ghc92/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc92/vscode-extension-schema.golden.json @@ -249,9 +249,9 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.semanticTokens.config.class": { - "default": "class", - "description": "LSP semantic token type to use for typeclasses", + "haskell.plugin.semanticTokens.config.classMethodToken": { + "default": "method", + "description": "LSP semantic token type to use for typeclass methods", "enum": [ "namespace", "type", @@ -305,9 +305,9 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.classMethod": { - "default": "method", - "description": "LSP semantic token type to use for typeclass methods", + "haskell.plugin.semanticTokens.config.classToken": { + "default": "class", + "description": "LSP semantic token type to use for typeclasses", "enum": [ "namespace", "type", @@ -361,7 +361,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.dataConstructor": { + "haskell.plugin.semanticTokens.config.dataConstructorToken": { "default": "enumMember", "description": "LSP semantic token type to use for data constructors", "enum": [ @@ -417,7 +417,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.function": { + "haskell.plugin.semanticTokens.config.functionToken": { "default": "function", "description": "LSP semantic token type to use for functions", "enum": [ @@ -473,7 +473,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.patternSynonym": { + "haskell.plugin.semanticTokens.config.patternSynonymToken": { "default": "macro", "description": "LSP semantic token type to use for pattern synonyms", "enum": [ @@ -529,7 +529,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.recordField": { + "haskell.plugin.semanticTokens.config.recordFieldToken": { "default": "property", "description": "LSP semantic token type to use for record fields", "enum": [ @@ -585,7 +585,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeConstructor": { + "haskell.plugin.semanticTokens.config.typeConstructorToken": { "default": "enum", "description": "LSP semantic token type to use for type constructors", "enum": [ @@ -641,7 +641,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeFamily": { + "haskell.plugin.semanticTokens.config.typeFamilyToken": { "default": "interface", "description": "LSP semantic token type to use for type families", "enum": [ @@ -697,7 +697,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeSynonym": { + "haskell.plugin.semanticTokens.config.typeSynonymToken": { "default": "type", "description": "LSP semantic token type to use for type synonyms", "enum": [ @@ -753,7 +753,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeVariable": { + "haskell.plugin.semanticTokens.config.typeVariableToken": { "default": "typeParameter", "description": "LSP semantic token type to use for type variables", "enum": [ @@ -809,7 +809,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.variable": { + "haskell.plugin.semanticTokens.config.variableToken": { "default": "variable", "description": "LSP semantic token type to use for variables", "enum": [ diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json index 2ff8dffff1..6b1a3c3b5f 100644 --- a/test/testdata/schema/ghc94/default-config.golden.json +++ b/test/testdata/schema/ghc94/default-config.golden.json @@ -116,17 +116,17 @@ }, "semanticTokens": { "config": { - "class": "class", - "classMethod": "method", - "dataConstructor": "enumMember", - "function": "function", - "patternSynonym": "macro", - "recordField": "property", - "typeConstructor": "enum", - "typeFamily": "interface", - "typeSynonym": "type", - "typeVariable": "typeParameter", - "variable": "variable" + "classMethodToken": "method", + "classToken": "class", + "dataConstructorToken": "enumMember", + "functionToken": "function", + "patternSynonymToken": "macro", + "recordFieldToken": "property", + "typeConstructorToken": "enum", + "typeFamilyToken": "interface", + "typeSynonymToken": "type", + "typeVariableToken": "typeParameter", + "variableToken": "variable" }, "globalOn": false }, diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json index 509448dff7..6b3cdc4384 100644 --- a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json @@ -249,9 +249,9 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.semanticTokens.config.class": { - "default": "class", - "description": "LSP semantic token type to use for typeclasses", + "haskell.plugin.semanticTokens.config.classMethodToken": { + "default": "method", + "description": "LSP semantic token type to use for typeclass methods", "enum": [ "namespace", "type", @@ -305,9 +305,9 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.classMethod": { - "default": "method", - "description": "LSP semantic token type to use for typeclass methods", + "haskell.plugin.semanticTokens.config.classToken": { + "default": "class", + "description": "LSP semantic token type to use for typeclasses", "enum": [ "namespace", "type", @@ -361,7 +361,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.dataConstructor": { + "haskell.plugin.semanticTokens.config.dataConstructorToken": { "default": "enumMember", "description": "LSP semantic token type to use for data constructors", "enum": [ @@ -417,7 +417,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.function": { + "haskell.plugin.semanticTokens.config.functionToken": { "default": "function", "description": "LSP semantic token type to use for functions", "enum": [ @@ -473,7 +473,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.patternSynonym": { + "haskell.plugin.semanticTokens.config.patternSynonymToken": { "default": "macro", "description": "LSP semantic token type to use for pattern synonyms", "enum": [ @@ -529,7 +529,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.recordField": { + "haskell.plugin.semanticTokens.config.recordFieldToken": { "default": "property", "description": "LSP semantic token type to use for record fields", "enum": [ @@ -585,7 +585,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeConstructor": { + "haskell.plugin.semanticTokens.config.typeConstructorToken": { "default": "enum", "description": "LSP semantic token type to use for type constructors", "enum": [ @@ -641,7 +641,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeFamily": { + "haskell.plugin.semanticTokens.config.typeFamilyToken": { "default": "interface", "description": "LSP semantic token type to use for type families", "enum": [ @@ -697,7 +697,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeSynonym": { + "haskell.plugin.semanticTokens.config.typeSynonymToken": { "default": "type", "description": "LSP semantic token type to use for type synonyms", "enum": [ @@ -753,7 +753,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeVariable": { + "haskell.plugin.semanticTokens.config.typeVariableToken": { "default": "typeParameter", "description": "LSP semantic token type to use for type variables", "enum": [ @@ -809,7 +809,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.variable": { + "haskell.plugin.semanticTokens.config.variableToken": { "default": "variable", "description": "LSP semantic token type to use for variables", "enum": [ diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json index 2ff8dffff1..6b1a3c3b5f 100644 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -116,17 +116,17 @@ }, "semanticTokens": { "config": { - "class": "class", - "classMethod": "method", - "dataConstructor": "enumMember", - "function": "function", - "patternSynonym": "macro", - "recordField": "property", - "typeConstructor": "enum", - "typeFamily": "interface", - "typeSynonym": "type", - "typeVariable": "typeParameter", - "variable": "variable" + "classMethodToken": "method", + "classToken": "class", + "dataConstructorToken": "enumMember", + "functionToken": "function", + "patternSynonymToken": "macro", + "recordFieldToken": "property", + "typeConstructorToken": "enum", + "typeFamilyToken": "interface", + "typeSynonymToken": "type", + "typeVariableToken": "typeParameter", + "variableToken": "variable" }, "globalOn": false }, diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json index 509448dff7..6b3cdc4384 100644 --- a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json @@ -249,9 +249,9 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.semanticTokens.config.class": { - "default": "class", - "description": "LSP semantic token type to use for typeclasses", + "haskell.plugin.semanticTokens.config.classMethodToken": { + "default": "method", + "description": "LSP semantic token type to use for typeclass methods", "enum": [ "namespace", "type", @@ -305,9 +305,9 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.classMethod": { - "default": "method", - "description": "LSP semantic token type to use for typeclass methods", + "haskell.plugin.semanticTokens.config.classToken": { + "default": "class", + "description": "LSP semantic token type to use for typeclasses", "enum": [ "namespace", "type", @@ -361,7 +361,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.dataConstructor": { + "haskell.plugin.semanticTokens.config.dataConstructorToken": { "default": "enumMember", "description": "LSP semantic token type to use for data constructors", "enum": [ @@ -417,7 +417,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.function": { + "haskell.plugin.semanticTokens.config.functionToken": { "default": "function", "description": "LSP semantic token type to use for functions", "enum": [ @@ -473,7 +473,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.patternSynonym": { + "haskell.plugin.semanticTokens.config.patternSynonymToken": { "default": "macro", "description": "LSP semantic token type to use for pattern synonyms", "enum": [ @@ -529,7 +529,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.recordField": { + "haskell.plugin.semanticTokens.config.recordFieldToken": { "default": "property", "description": "LSP semantic token type to use for record fields", "enum": [ @@ -585,7 +585,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeConstructor": { + "haskell.plugin.semanticTokens.config.typeConstructorToken": { "default": "enum", "description": "LSP semantic token type to use for type constructors", "enum": [ @@ -641,7 +641,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeFamily": { + "haskell.plugin.semanticTokens.config.typeFamilyToken": { "default": "interface", "description": "LSP semantic token type to use for type families", "enum": [ @@ -697,7 +697,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeSynonym": { + "haskell.plugin.semanticTokens.config.typeSynonymToken": { "default": "type", "description": "LSP semantic token type to use for type synonyms", "enum": [ @@ -753,7 +753,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeVariable": { + "haskell.plugin.semanticTokens.config.typeVariableToken": { "default": "typeParameter", "description": "LSP semantic token type to use for type variables", "enum": [ @@ -809,7 +809,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.variable": { + "haskell.plugin.semanticTokens.config.variableToken": { "default": "variable", "description": "LSP semantic token type to use for variables", "enum": [ diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json index 34224ce426..0a8cd9afe7 100644 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -81,17 +81,17 @@ }, "semanticTokens": { "config": { - "class": "class", - "classMethod": "method", - "dataConstructor": "enumMember", - "function": "function", - "patternSynonym": "macro", - "recordField": "property", - "typeConstructor": "enum", - "typeFamily": "interface", - "typeSynonym": "type", - "typeVariable": "typeParameter", - "variable": "variable" + "classMethodToken": "method", + "classToken": "class", + "dataConstructorToken": "enumMember", + "functionToken": "function", + "patternSynonymToken": "macro", + "recordFieldToken": "property", + "typeConstructorToken": "enum", + "typeFamilyToken": "interface", + "typeSynonymToken": "type", + "typeVariableToken": "typeParameter", + "variableToken": "variable" }, "globalOn": false }, diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json index 23b57e9b3c..962f3138b3 100644 --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -171,9 +171,9 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.semanticTokens.config.class": { - "default": "class", - "description": "LSP semantic token type to use for typeclasses", + "haskell.plugin.semanticTokens.config.classMethodToken": { + "default": "method", + "description": "LSP semantic token type to use for typeclass methods", "enum": [ "namespace", "type", @@ -227,9 +227,9 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.classMethod": { - "default": "method", - "description": "LSP semantic token type to use for typeclass methods", + "haskell.plugin.semanticTokens.config.classToken": { + "default": "class", + "description": "LSP semantic token type to use for typeclasses", "enum": [ "namespace", "type", @@ -283,7 +283,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.dataConstructor": { + "haskell.plugin.semanticTokens.config.dataConstructorToken": { "default": "enumMember", "description": "LSP semantic token type to use for data constructors", "enum": [ @@ -339,7 +339,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.function": { + "haskell.plugin.semanticTokens.config.functionToken": { "default": "function", "description": "LSP semantic token type to use for functions", "enum": [ @@ -395,7 +395,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.patternSynonym": { + "haskell.plugin.semanticTokens.config.patternSynonymToken": { "default": "macro", "description": "LSP semantic token type to use for pattern synonyms", "enum": [ @@ -451,7 +451,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.recordField": { + "haskell.plugin.semanticTokens.config.recordFieldToken": { "default": "property", "description": "LSP semantic token type to use for record fields", "enum": [ @@ -507,7 +507,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeConstructor": { + "haskell.plugin.semanticTokens.config.typeConstructorToken": { "default": "enum", "description": "LSP semantic token type to use for type constructors", "enum": [ @@ -563,7 +563,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeFamily": { + "haskell.plugin.semanticTokens.config.typeFamilyToken": { "default": "interface", "description": "LSP semantic token type to use for type families", "enum": [ @@ -619,7 +619,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeSynonym": { + "haskell.plugin.semanticTokens.config.typeSynonymToken": { "default": "type", "description": "LSP semantic token type to use for type synonyms", "enum": [ @@ -675,7 +675,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.typeVariable": { + "haskell.plugin.semanticTokens.config.typeVariableToken": { "default": "typeParameter", "description": "LSP semantic token type to use for type variables", "enum": [ @@ -731,7 +731,7 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.semanticTokens.config.variable": { + "haskell.plugin.semanticTokens.config.variableToken": { "default": "variable", "description": "LSP semantic token type to use for variables", "enum": [ From 897e0d31c9b8d6fdadec7c3e485621d7d26c0ded Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 14 Jan 2024 06:29:27 +0800 Subject: [PATCH 23/24] cleanup --- config.vscode | 886 -------------------------------------------------- generate.bash | 4 - 2 files changed, 890 deletions(-) delete mode 100644 config.vscode delete mode 100644 generate.bash diff --git a/config.vscode b/config.vscode deleted file mode 100644 index 535561ef70..0000000000 --- a/config.vscode +++ /dev/null @@ -1,886 +0,0 @@ -{ - "haskell.plugin.alternateNumberFormat.globalOn": { - "default": true, - "description": "Enables alternateNumberFormat plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.codeActionsOn": { - "default": true, - "description": "Enables cabal code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.cabal.completionOn": { - "default": true, - "description": "Enables cabal completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.callHierarchy.globalOn": { - "default": true, - "description": "Enables callHierarchy plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.changeTypeSignature.globalOn": { - "default": true, - "description": "Enables changeTypeSignature plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeActionsOn": { - "default": true, - "description": "Enables class code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.class.codeLensOn": { - "default": true, - "description": "Enables class code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.diff": { - "default": true, - "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.config.exception": { - "default": false, - "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.eval.globalOn": { - "default": true, - "description": "Enables eval plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fields.globalOn": { - "default": true, - "description": "Enables explicit-fields plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.explicit-fixity.globalOn": { - "default": true, - "description": "Enables explicit-fixity plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.fourmolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"fourmolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.gadt.globalOn": { - "default": true, - "description": "Enables gadt plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-bindings.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-bindings plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-fill-holes plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-imports-exports plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { - "default": true, - "description": "Enables ghcide-code-actions-type-signatures plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.autoExtendOn": { - "default": true, - "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.config.snippetsOn": { - "default": true, - "markdownDescription": "Inserts snippets when using code completions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-completions.globalOn": { - "default": true, - "description": "Enables ghcide-completions plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols hover", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { - "default": true, - "description": "Enables ghcide-hover-and-symbols symbols", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ghcide-type-lenses.config.mode": { - "default": "always", - "description": "Control how type lenses are shown", - "enum": [ - "always", - "exported", - "diagnostics" - ], - "enumDescriptions": [ - "Always displays type lenses of global bindings", - "Only display type lenses of exported global bindings", - "Follows error messages produced by GHC about missing signatures" - ], - "scope": "resource", - "type": "string" - }, - "haskell.plugin.ghcide-type-lenses.globalOn": { - "default": true, - "description": "Enables ghcide-type-lenses plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.codeActionsOn": { - "default": true, - "description": "Enables hlint code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.hlint.config.flags": { - "default": [], - "markdownDescription": "Flags used by hlint", - "scope": "resource", - "type": "array" - }, - "haskell.plugin.hlint.diagnosticsOn": { - "default": true, - "description": "Enables hlint diagnostics", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeActionsOn": { - "default": true, - "description": "Enables importLens code actions", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.importLens.codeLensOn": { - "default": true, - "description": "Enables importLens code lenses", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.moduleName.globalOn": { - "default": true, - "description": "Enables moduleName plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.ormolu.config.external": { - "default": false, - "markdownDescription": "Call out to an external \"ormolu\" executable, rather than using the bundled library", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.overloaded-record-dot.globalOn": { - "default": true, - "description": "Enables overloaded-record-dot plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-completion.globalOn": { - "default": true, - "description": "Enables pragmas-completion plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-disable.globalOn": { - "default": true, - "description": "Enables pragmas-disable plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.pragmas-suggest.globalOn": { - "default": true, - "description": "Enables pragmas-suggest plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.qualifyImportedNames.globalOn": { - "default": true, - "description": "Enables qualifyImportedNames plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.config.crossModule": { - "default": false, - "markdownDescription": "Enable experimental cross-module renaming", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.rename.globalOn": { - "default": true, - "description": "Enables rename plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.retrie.globalOn": { - "default": true, - "description": "Enables retrie plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.semanticTokens.config.class": { - "default": "class", - "description": "LSP semantic token type to use for Class", - "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.classMethod": { - "default": "method", - "description": "LSP semantic token type to use for ClassMethod", - "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.dataCon": { - "default": "enumMember", - "description": "LSP semantic token type to use for DataCon", - "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.function": { - "default": "function", - "description": "LSP semantic token type to use for Function", - "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.patternSyn": { - "default": "macro", - "description": "LSP semantic token type to use for PatternSyn", - "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.recField": { - "default": "property", - "description": "LSP semantic token type to use for RecField", - "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.typeCon": { - "default": "enum", - "description": "LSP semantic token type to use for TypeCon", - "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.typeFamily": { - "default": "interface", - "description": "LSP semantic token type to use for TypeFamily", - "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.typeSyn": { - "default": "type", - "description": "LSP semantic token type to use for TypeSyn", - "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.typeVariable": { - "default": "typeParameter", - "description": "LSP semantic token type to use for TypeVariable", - "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.variable": { - "default": "variable", - "description": "LSP semantic token type to use for Variable", - "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", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.splice.globalOn": { - "default": true, - "description": "Enables splice plugin", - "scope": "resource", - "type": "boolean" - }, - "haskell.plugin.stan.globalOn": { - "default": false, - "description": "Enables stan plugin", - "scope": "resource", - "type": "boolean" - } -} diff --git a/generate.bash b/generate.bash deleted file mode 100644 index 531115710c..0000000000 --- a/generate.bash +++ /dev/null @@ -1,4 +0,0 @@ -ghcup set ghc 9.2.8; cabal clean; cabal test --test-option="-p /generate schema/" -ghcup set ghc 9.4.8; cabal clean; cabal test --test-option="-p /generate schema/" -ghcup set ghc 9.6.2; cabal clean; cabal test --test-option="-p /generate schema/" -ghcup set ghc 9.8.1; cabal clean; cabal test --test-option="-p /generate schema/" From b6825a28cea70b394053cd20703124e57f64f905 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 15 Jan 2024 00:59:33 +0800 Subject: [PATCH 24/24] fix merge --- plugins/hls-semantic-tokens-plugin/test/Main.hs | 12 ++++++------ .../testdata/TRecordDuplicateRecordFields.expected | 8 ++++---- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/plugins/hls-semantic-tokens-plugin/test/Main.hs b/plugins/hls-semantic-tokens-plugin/test/Main.hs index 84f544b8fa..ff02764658 100644 --- a/plugins/hls-semantic-tokens-plugin/test/Main.hs +++ b/plugins/hls-semantic-tokens-plugin/test/Main.hs @@ -201,12 +201,12 @@ semanticTokensDataTypeTests :: TestTree semanticTokensDataTypeTests = testGroup "get semantic Tokens" - [ goldenWithSemanticTokens "simple datatype" "TDataType", - goldenWithSemanticTokens "record" "TRecord", - goldenWithSemanticTokens "record With DuplicateRecordFields" "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 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"