Merge branch 'master' into note-references

mergify[bot] · web-flow · commit 4aa933d00c22 · 2025-06-09T10:08:45.000Z
diff --git a/cabal.project b/cabal.project
@@ -8,7 +8,7 @@ packages:
          ./hls-test-utils
 
 
-index-state: 2025-05-12T13:26:29Z
+index-state: 2025-06-07T14:57:40Z
 
 tests: True
 test-show-details: direct
diff --git a/ghcide-test/exe/Main.hs b/ghcide-test/exe/Main.hs
@@ -33,7 +33,6 @@ module Main (main) where
 import qualified HieDbRetry
 import           Test.Tasty
 import           Test.Tasty.Ingredients.Rerun
-import           Test.Tasty.Runners
 
 import           AsyncTests
 import           BootTests
@@ -71,7 +70,7 @@ import           WatchedFileTests
 main :: IO ()
 main = do
   -- We mess with env vars so run single-threaded.
-  defaultMainWithRerun $ PlusTestOptions mkSequential $ testGroup "ghcide"
+  defaultMainWithRerun $ testGroup "ghcide"
     [ OpenCloseTest.tests
     , InitializeResponseTests.tests
     , CompletionTests.tests
@@ -105,6 +104,3 @@ main = do
     , HieDbRetry.tests
     , ExceptionTests.tests
     ]
-    where
-       PlusTestOptions mkSequential _ =sequentialTestGroup "foo" AllFinish []
-
diff --git a/ghcide/src/Development/IDE/Types/Diagnostics.hs b/ghcide/src/Development/IDE/Types/Diagnostics.hs
@@ -102,20 +102,19 @@ ideErrorFromLspDiag lspDiag fdFilePath mbOrigMsg =
       fdLspDiagnostic =
         lspDiag
           & attachReason (fmap (diagnosticReason . errMsgDiagnostic) mbOrigMsg)
-          & setGhcCode mbOrigMsg
+          & attachDiagnosticCode ((diagnosticCode . errMsgDiagnostic) =<< mbOrigMsg)
   in
   FileDiagnostic {..}
 
--- | Set the code of the 'LSP.Diagnostic' to the GHC diagnostic code which is linked
+-- | Set the code of the 'LSP.Diagnostic' to the GHC diagnostic code, and include the link
 -- to https://errors.haskell.org/.
-setGhcCode :: Maybe (MsgEnvelope GhcMessage) -> LSP.Diagnostic -> LSP.Diagnostic
-setGhcCode mbOrigMsg diag =
-  let mbGhcCode = do
-          origMsg <- mbOrigMsg
-          code <- diagnosticCode (errMsgDiagnostic origMsg)
-          pure (InR (showGhcCode code))
-  in
-  diag { _code = mbGhcCode <|> _code diag }
+attachDiagnosticCode :: Maybe DiagnosticCode -> LSP.Diagnostic -> LSP.Diagnostic
+attachDiagnosticCode Nothing diag = diag
+attachDiagnosticCode (Just code) diag =
+    let
+        textualCode = showGhcCode code
+        codeDesc = LSP.CodeDescription{ _href = Uri $ "https://errors.haskell.org/messages/" <> textualCode }
+    in diag { _code = Just (InR textualCode), _codeDescription = Just codeDesc}
 
 #if MIN_VERSION_ghc(9,9,0)
 -- DiagnosticCode only got a show instance in 9.10.1
diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal
@@ -806,7 +806,7 @@ library hls-stan-plugin
     , lsp-types
     , text
     , unordered-containers
-    , stan >= 0.1.2.0
+    , stan >= 0.2.1.0
     , trial
     , directory
 
@@ -2115,7 +2115,7 @@ test-suite ghcide-tests
     , sqlite-simple
     , stm
     , stm-containers
-    , tasty                  >=1.5
+    , tasty
     , tasty-expected-failure
     , tasty-hunit             >=0.10
     , tasty-quickcheck
diff --git a/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs b/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs
@@ -5,7 +5,8 @@
 
 module Ide.Plugin.ConfigUtils (
   pluginsToDefaultConfig,
-  pluginsToVSCodeExtensionSchema
+  pluginsToVSCodeExtensionSchema,
+  pluginsCustomConfigToMarkdownTables
   ) where
 
 import           Control.Lens                  (at, (&), (?~))
@@ -18,8 +19,15 @@ import qualified Data.Dependent.Sum            as DSum
 import           Data.List.Extra               (nubOrd)
 import           Data.String                   (IsString (fromString))
 import qualified Data.Text                     as T
+import           GHC.TypeLits                  (symbolVal)
 import           Ide.Plugin.Config
-import           Ide.Plugin.Properties         (toDefaultJSON,
+import           Ide.Plugin.Properties         (KeyNameProxy, MetaData (..),
+                                                PluginCustomConfig (..),
+                                                PluginCustomConfigParam (..),
+                                                Properties (..),
+                                                SPropertyKey (..),
+                                                SomePropertyKeyWithMetaData (..),
+                                                toDefaultJSON,
                                                 toVSCodeExtensionSchema)
 import           Ide.Types
 import           Language.LSP.Protocol.Message
@@ -143,3 +151,92 @@ pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlug
             ]
         withIdPrefix x = "haskell.plugin." <> pId <> "." <> x
         toKey' = fromString . T.unpack . withIdPrefix
+
+
+-- | Generates markdown tables for custom config
+pluginsCustomConfigToMarkdownTables :: IdePlugins a -> T.Text
+pluginsCustomConfigToMarkdownTables IdePlugins {..} = T.unlines
+    $ map renderCfg
+    $ filter (\(PluginCustomConfig _ params) -> not $ null params)
+    $ map toPluginCustomConfig ipMap
+  where
+    toPluginCustomConfig :: PluginDescriptor ideState -> PluginCustomConfig
+    toPluginCustomConfig PluginDescriptor {pluginConfigDescriptor = ConfigDescriptor {configCustomConfig = c}, pluginId = PluginId pId} =
+        PluginCustomConfig { pcc'Name = pId, pcc'Params = toPluginCustomConfigParams c}
+    toPluginCustomConfigParams :: CustomConfig -> [PluginCustomConfigParam]
+    toPluginCustomConfigParams (CustomConfig p) = toPluginCustomConfigParams' p
+    toPluginCustomConfigParams' :: Properties r -> [PluginCustomConfigParam]
+    toPluginCustomConfigParams' EmptyProperties = []
+    toPluginCustomConfigParams' (ConsProperties (keyNameProxy :: KeyNameProxy s) (k :: SPropertyKey k) (m :: MetaData t) xs) =
+        toEntry (SomePropertyKeyWithMetaData k m) : toPluginCustomConfigParams' xs
+        where
+            toEntry :: SomePropertyKeyWithMetaData -> PluginCustomConfigParam
+            toEntry (SomePropertyKeyWithMetaData SNumber MetaData {..}) =
+                PluginCustomConfigParam {
+                    pccp'Name = T.pack $ symbolVal keyNameProxy,
+                    pccp'Description = description,
+                    pccp'Default = T.pack $ show defaultValue,
+                    pccp'EnumValues = []
+                }
+            toEntry (SomePropertyKeyWithMetaData SInteger MetaData {..}) =
+                PluginCustomConfigParam {
+                    pccp'Name = T.pack $ symbolVal keyNameProxy,
+                    pccp'Description = description,
+                    pccp'Default = T.pack $ show defaultValue,
+                    pccp'EnumValues = []
+                }
+            toEntry (SomePropertyKeyWithMetaData SString MetaData {..}) =
+                PluginCustomConfigParam {
+                    pccp'Name = T.pack $ symbolVal keyNameProxy,
+                    pccp'Description = description,
+                    pccp'Default = T.pack $ show defaultValue,
+                    pccp'EnumValues = []
+                }
+            toEntry (SomePropertyKeyWithMetaData SBoolean MetaData {..}) =
+                PluginCustomConfigParam {
+                    pccp'Name = T.pack $ symbolVal keyNameProxy,
+                    pccp'Description = description,
+                    pccp'Default = T.pack $ show defaultValue,
+                    pccp'EnumValues = []
+                }
+            toEntry (SomePropertyKeyWithMetaData (SObject _) MetaData {..}) =
+                PluginCustomConfigParam {
+                    pccp'Name = T.pack $ symbolVal keyNameProxy,
+                    pccp'Description = description,
+                    pccp'Default = "TODO: nested object", -- T.pack $ show defaultValue,
+                    pccp'EnumValues = []
+                }
+            toEntry (SomePropertyKeyWithMetaData (SArray _) MetaData {..}) =
+                PluginCustomConfigParam {
+                    pccp'Name = T.pack $ symbolVal keyNameProxy,
+                    pccp'Description = description,
+                    pccp'Default = "TODO: Array values", -- T.pack $ show defaultValue,
+                    pccp'EnumValues = []
+                }
+            toEntry (SomePropertyKeyWithMetaData (SEnum _) EnumMetaData {..}) =
+                PluginCustomConfigParam {
+                    pccp'Name = T.pack $ symbolVal keyNameProxy,
+                    pccp'Description = description,
+                    pccp'Default = T.pack $ show defaultValue,
+                    pccp'EnumValues = map (T.pack . show) enumValues
+                }
+            toEntry (SomePropertyKeyWithMetaData SProperties PropertiesMetaData {..}) =
+                PluginCustomConfigParam {
+                    pccp'Name = T.pack $ symbolVal keyNameProxy,
+                    pccp'Description = description,
+                    pccp'Default = T.pack $ show defaultValue,
+                    pccp'EnumValues = []
+                }
+    renderCfg :: PluginCustomConfig -> T.Text
+    renderCfg (PluginCustomConfig pId pccParams) =
+        T.unlines (pluginHeader : tableHeader : rows pccParams)
+        where
+            pluginHeader = "## " <> pId
+            tableHeader =
+                "| Property | Description | Default | Allowed values |" <> "\n" <>
+                "| --- | --- | --- | --- |"
+            rows = map renderRow
+            renderRow PluginCustomConfigParam {..} =
+                "| `" <> pccp'Name <> "` | " <> pccp'Description <> " | `" <> pccp'Default <> "` | " <> renderEnum pccp'EnumValues <> " |"
+            renderEnum [] = " &nbsp; " -- Placeholder to prevent missing cells
+            renderEnum vs = "<ul> " <> (T.intercalate " " $ map (\x -> "<li><code>" <> x <> "</code></li>") vs) <> " </ul>"
diff --git a/hls-plugin-api/src/Ide/Plugin/Properties.hs b/hls-plugin-api/src/Ide/Plugin/Properties.hs
@@ -21,9 +21,10 @@ module Ide.Plugin.Properties
     MetaData (..),
     PropertyKey (..),
     SPropertyKey (..),
+    SomePropertyKeyWithMetaData (..),
     KeyNameProxy (..),
     KeyNamePath (..),
-    Properties,
+    Properties(..),
     HasProperty,
     HasPropertyByPath,
     emptyProperties,
@@ -42,6 +43,8 @@ module Ide.Plugin.Properties
     usePropertyByPathEither,
     usePropertyByPath,
     (&),
+    PluginCustomConfig(..),
+    PluginCustomConfigParam(..),
   )
 where
 
@@ -516,3 +519,15 @@ toVSCodeExtensionSchema' ps = case ps of
           ]
       (SomePropertyKeyWithMetaData SProperties PropertiesMetaData {..}) ->
         map (first Just) $ toVSCodeExtensionSchema' childrenProperties
+
+data PluginCustomConfig = PluginCustomConfig {
+    pcc'Name   :: T.Text,
+    pcc'Params :: [PluginCustomConfigParam]
+}
+data PluginCustomConfigParam = PluginCustomConfigParam {
+    pccp'Name        :: T.Text,
+    pccp'Description :: T.Text,
+    pccp'Default     :: T.Text,
+    pccp'EnumValues  :: [T.Text]
+}
+
diff --git a/src/Ide/Arguments.hs b/src/Ide/Arguments.hs
@@ -33,6 +33,7 @@ data Arguments
   | BiosMode BiosAction
   | Ghcide GhcideArguments
   | VSCodeExtensionSchemaMode
+  | PluginsCustomConfigMarkdownReferenceMode
   | DefaultConfigurationMode
   | PrintLibDir
 
@@ -69,6 +70,7 @@ getArguments exeName plugins = execParser opts
       <|> hsubparser
         (  command "vscode-extension-schema" extensionSchemaCommand
         <> command "generate-default-config" generateDefaultConfigCommand
+        <> command "plugins-custom-config-markdown-reference" pluginsCustomConfigMarkdownReferenceCommand
         )
       <|> listPluginsParser
       <|> BiosMode <$> biosParser
@@ -86,6 +88,9 @@ getArguments exeName plugins = execParser opts
     generateDefaultConfigCommand =
         info (pure DefaultConfigurationMode)
              (fullDesc <> progDesc "Print config supported by the server with default values")
+    pluginsCustomConfigMarkdownReferenceCommand =
+        info (pure PluginsCustomConfigMarkdownReferenceMode)
+            (fullDesc <> progDesc "Print markdown reference for plugins custom config")
 
 printVersionParser :: String -> Parser PrintVersion
 printVersionParser exeName =
diff --git a/src/Ide/Main.hs b/src/Ide/Main.hs
@@ -15,6 +15,7 @@ import           Data.Function                 ((&))
 import           Data.List                     (sortOn)
 import           Data.Text                     (Text)
 import qualified Data.Text                     as T
+import qualified Data.Text.IO                  as T (putStrLn)
 import           Data.Text.Lazy.Encoding       (decodeUtf8)
 import qualified Data.Text.Lazy.IO             as LT
 import           Development.IDE.Core.Rules    hiding (Log)
@@ -28,7 +29,8 @@ import           HIE.Bios.Types                hiding (Log)
 import qualified HIE.Bios.Types                as HieBios
 import           Ide.Arguments
 import           Ide.Logger                    as G
-import           Ide.Plugin.ConfigUtils        (pluginsToDefaultConfig,
+import           Ide.Plugin.ConfigUtils        (pluginsCustomConfigToMarkdownTables,
+                                                pluginsToDefaultConfig,
                                                 pluginsToVSCodeExtensionSchema)
 import           Ide.Types                     (IdePlugins, PluginId (PluginId),
                                                 describePlugin, ipMap, pluginId)
@@ -103,6 +105,8 @@ defaultMain recorder args idePlugins = do
 
         VSCodeExtensionSchemaMode -> do
           LT.putStrLn $ decodeUtf8 $ encodePrettySorted $ pluginsToVSCodeExtensionSchema idePlugins
+        PluginsCustomConfigMarkdownReferenceMode -> do
+            T.putStrLn $ pluginsCustomConfigToMarkdownTables idePlugins
         DefaultConfigurationMode -> do
           LT.putStrLn $ decodeUtf8 $ encodePrettySorted $ pluginsToDefaultConfig idePlugins
         PrintLibDir -> do
diff --git a/stack-lts22.yaml b/stack-lts22.yaml
@@ -15,6 +15,8 @@ ghc-options:
 allow-newer: true
 allow-newer-deps:
   - extensions
+  # stan dependencies
+  - directory-ospath-streaming
 
 extra-deps:
   - Diff-0.5
@@ -27,10 +29,9 @@ extra-deps:
   - lsp-types-2.3.0.0
   - monad-dijkstra-0.1.1.4 # 5
   - retrie-1.2.3
-  - tasty-1.5.3
 
   # stan and friends
-  - stan-0.1.3.0
+  - stan-0.2.1.0
   - dir-traverse-0.2.3.0
   - extensions-0.1.0.1
   - tomland-1.3.3.2
@@ -40,6 +41,7 @@ extra-deps:
   - validation-selective-0.2.0.0
   - cabal-add-0.1
   - cabal-install-parsers-0.6.1.1
+  - directory-ospath-streaming-0.2.2
 
 
 configure-options:
@@ -57,6 +59,9 @@ flags:
     BuildExecutable: false
   cabal-add:
     cabal-syntax: true
+  # stan dependencies
+  directory-ospath-streaming:
+      os-string: false
 
 nix:
   packages: [icu libcxx zlib]
diff --git a/stack.yaml b/stack.yaml
@@ -17,6 +17,8 @@ allow-newer-deps:
   - extensions
   - hw-fingertree
   - retrie
+  # stan dependencies
+  - directory-ospath-streaming
 
 extra-deps:
   - floskell-0.11.1
@@ -28,12 +30,13 @@ extra-deps:
   - retrie-1.2.3
 
   # stan dependencies not found in the stackage snapshot
-  - stan-0.1.3.0
+  - stan-0.2.1.0
   - dir-traverse-0.2.3.0
   - extensions-0.1.0.1
   - trial-0.0.0.0
   - trial-optparse-applicative-0.0.0.0
   - trial-tomland-0.0.0.0
+  - directory-ospath-streaming-0.2.2
 
 configure-options:
   ghcide:
@@ -50,6 +53,9 @@ flags:
     BuildExecutable: false
   cabal-add:
     cabal-syntax: true
+  # stan dependencies
+  directory-ospath-streaming:
+      os-string: false
 
 nix:
   packages: [icu libcxx zlib]
diff --git a/test/functional/ConfigSchema.hs b/test/functional/ConfigSchema.hs
@@ -31,6 +31,9 @@ tests = testGroup "generate schema"
   , goldenGitDiff "generate-default-config" (defaultConfigFp ghcVersion) $ do
       stdout <- readProcess hlsExeCommand ["generate-default-config"] ""
       pure $ BS.pack stdout
+  , goldenGitDiff "plugins-custom-config-markdown-reference" (markdownReferenceFp ghcVersion) $ do
+    stdout <- readProcess hlsExeCommand ["plugins-custom-config-markdown-reference"] ""
+    pure $ BS.pack stdout
   ]
 
 vscodeSchemaFp :: GhcVersion -> FilePath
@@ -39,11 +42,17 @@ vscodeSchemaFp ghcVer = "test" </> "testdata" </> "schema" </> prettyGhcVersion
 defaultConfigFp :: GhcVersion -> FilePath
 defaultConfigFp ghcVer = "test" </> "testdata" </> "schema" </> prettyGhcVersion ghcVer </> generateDefaultConfigJson
 
+markdownReferenceFp :: GhcVersion -> FilePath
+markdownReferenceFp ghcVer = "test" </> "testdata" </> "schema" </> prettyGhcVersion ghcVer </> markdownReferenceMd
+
 vscodeSchemaJson :: FilePath
 vscodeSchemaJson = "vscode-extension-schema.golden.json"
 
 generateDefaultConfigJson :: FilePath
 generateDefaultConfigJson = "default-config.golden.json"
 
+markdownReferenceMd :: FilePath
+markdownReferenceMd = "markdown-reference.md"
+
 prettyGhcVersion :: GhcVersion -> String
 prettyGhcVersion ghcVer = map toLower (show ghcVer)
diff --git a/test/testdata/schema/ghc910/markdown-reference.md b/test/testdata/schema/ghc910/markdown-reference.md
diff --git a/test/testdata/schema/ghc912/markdown-reference.md b/test/testdata/schema/ghc912/markdown-reference.md
diff --git a/test/testdata/schema/ghc96/markdown-reference.md b/test/testdata/schema/ghc96/markdown-reference.md
diff --git a/test/testdata/schema/ghc98/markdown-reference.md b/test/testdata/schema/ghc98/markdown-reference.md
