@@ -15,6 +15,7 @@ module Ide.Plugin
1515 , allLspCmdIds
1616 , allLspCmdIds'
1717 , getPid
18+ , responseError
1819 ) where
1920
2021import Control.Lens ( (^.) )
@@ -59,6 +60,7 @@ asGhcIdePlugin mp =
5960 -- Note: diagnostics are provided via Rules from pluginDiagnosticProvider
6061 mkPlugin hoverPlugins pluginHoverProvider <>
6162 -- TODO: symbols via pluginSymbolProvider
63+ mkPlugin symbolsPlugin pluginSymbolsProvider <>
6264 mkPlugin formatterPlugins pluginFormattingProvider
6365 -- TODO: completions
6466 where
@@ -401,6 +403,49 @@ makeHover hps _lf ideState params
401403-- ---------------------------------------------------------------------
402404-- ---------------------------------------------------------------------
403405
406+ symbolsPlugin :: [(PluginId , SymbolsProvider )] -> Plugin Config
407+ symbolsPlugin hs = Plugin symbolsRules (symbolsHandlers hs)
408+
409+ symbolsRules :: Rules ()
410+ symbolsRules = mempty
411+
412+ symbolsHandlers :: [(PluginId , SymbolsProvider )] -> PartialHandlers Config
413+ symbolsHandlers hps = PartialHandlers $ \ WithMessage {.. } x ->
414+ return x {LSP. documentSymbolHandler = withResponse RspDocumentSymbols (makeSymbols hps)}
415+
416+ makeSymbols :: [(PluginId , SymbolsProvider )]
417+ -> LSP. LspFuncs Config
418+ -> IdeState
419+ -> DocumentSymbolParams
420+ -> IO (Either ResponseError DSResult )
421+ makeSymbols sps lf ideState params
422+ = do
423+ let uri' = params ^. textDocument . uri
424+ (C. ClientCapabilities _ tdc _ _) = LSP. clientCapabilities lf
425+ supportsHierarchy = fromMaybe False $ tdc >>= C. _documentSymbol
426+ >>= C. _hierarchicalDocumentSymbolSupport
427+ convertSymbols :: [DocumentSymbol ] -> DSResult
428+ convertSymbols symbs
429+ | supportsHierarchy = DSDocumentSymbols $ List symbs
430+ | otherwise = DSSymbolInformation (List $ concatMap (go Nothing ) symbs)
431+ where
432+ go :: Maybe T. Text -> DocumentSymbol -> [SymbolInformation ]
433+ go parent ds =
434+ let children' :: [SymbolInformation ]
435+ children' = concatMap (go (Just name')) (fromMaybe mempty (ds ^. children))
436+ loc = Location uri' (ds ^. range)
437+ name' = ds ^. name
438+ si = SymbolInformation name' (ds ^. kind) (ds ^. deprecated) loc parent
439+ in [si] <> children'
440+
441+ mhs <- mapM (\ (_,p) -> p ideState params) sps
442+ case rights mhs of
443+ [] -> return $ Left $ responseError $ T. pack $ show $ lefts mhs
444+ hs -> return $ Right $ convertSymbols $ concat hs
445+
446+ -- ---------------------------------------------------------------------
447+ -- ---------------------------------------------------------------------
448+
404449formatterPlugins :: [(PluginId , FormattingProvider IO )] -> Plugin Config
405450formatterPlugins providers
406451 = Plugin formatterRules
0 commit comments