semantic config keys use lower case in the first element

haskell · Jan 12, 2024 · 4d11ac7 · 4d11ac7
1 parent 6653b03
commit 4d11ac7
Show file tree

Hide file tree

Showing 2 changed files with 8 additions and 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
@@ -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
@@ -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