From 7f6820c3685ba3d856afcbaabf6180b590cee2f1 Mon Sep 17 00:00:00 2001 From: Anton Myasnikov Date: Tue, 8 Sep 2020 18:36:25 +0300 Subject: [PATCH] [LIGO-42] Support for document symbols Problem: We want to be able to extract document symbols from some ligo contract that are realised by @haskell-lsp@ client. Solution: Implement `extractDocumentSymbols` and integrate it with @haskell-lsp@. --- tools/lsp/squirrel/app/Main.hs | 8 ++ tools/lsp/squirrel/src/AST/Capabilities.hs | 1 + .../src/AST/Capabilities/DocumentSymbol.hs | 120 ++++++++++++++++++ tools/lsp/squirrel/src/Range.hs | 5 +- 4 files changed, 132 insertions(+), 2 deletions(-) create mode 100644 tools/lsp/squirrel/src/AST/Capabilities/DocumentSymbol.hs diff --git a/tools/lsp/squirrel/app/Main.hs b/tools/lsp/squirrel/app/Main.hs index bb8536b6e..a380f1023 100644 --- a/tools/lsp/squirrel/app/Main.hs +++ b/tools/lsp/squirrel/app/Main.hs @@ -104,6 +104,7 @@ lspHandlers rin = -- , Core.completionResolveHandler = Just $ passHandler rin ReqCompletionItemResolve , Core.foldingRangeHandler = Just $ passHandler rin ReqFoldingRange , Core.hoverHandler = Just $ passHandler rin ReqHover + , Core.documentSymbolHandler = Just $ passHandler rin ReqDocumentSymbols } passHandler :: TChan FromClientMessage -> (a -> FromClientMessage) -> Core.Handler a @@ -209,6 +210,7 @@ eventLoop funs chan = do stopDyingAlready funs req $ do U.logs $ "got completion resolve request: " <> show req respondWith funs req RspCompletionItemResolve (req ^. J.params) + ReqFoldingRange req -> do stopDyingAlready funs req $ do let uri = req ^. J.params . J.textDocument . J.uri @@ -233,6 +235,12 @@ eventLoop funs chan = do RspHover $ Core.makeResponseMessage req (hoverDecl pos tree) Core.sendFunc funs response + ReqDocumentSymbols req -> do + let uri = req ^. J.params . J.textDocument . J.uri + tree <- loadFromVFS funs uri + result <- extractDocumentSymbols uri tree + respondWith funs req RspDocumentSymbols (J.DSSymbolInformation $ J.List result) + _ -> U.logs "unknown msg" respondWith diff --git a/tools/lsp/squirrel/src/AST/Capabilities.hs b/tools/lsp/squirrel/src/AST/Capabilities.hs index 137014aae..e3d7d2ab7 100644 --- a/tools/lsp/squirrel/src/AST/Capabilities.hs +++ b/tools/lsp/squirrel/src/AST/Capabilities.hs @@ -5,3 +5,4 @@ import AST.Capabilities.Completion as Exports import AST.Capabilities.Find as Exports import AST.Capabilities.Folding as Exports import AST.Capabilities.Hover as Exports +import AST.Capabilities.DocumentSymbol as Exports diff --git a/tools/lsp/squirrel/src/AST/Capabilities/DocumentSymbol.hs b/tools/lsp/squirrel/src/AST/Capabilities/DocumentSymbol.hs new file mode 100644 index 000000000..54a7c5252 --- /dev/null +++ b/tools/lsp/squirrel/src/AST/Capabilities/DocumentSymbol.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE RecordWildCards #-} + +module AST.Capabilities.DocumentSymbol where + +import Control.Monad.Catch.Pure (MonadCatch) +import Control.Monad.Writer.Strict +import Data.Maybe (fromMaybe) +import Data.Text +import Duplo (match) +import Duplo.Pretty +import Duplo.Tree (Visit (Visit), visit) +import Language.Haskell.LSP.Types (SymbolInformation (..)) +import qualified Language.Haskell.LSP.Types as J + +import AST.Capabilities.Find +import AST.Scope +import AST.Skeleton +import Product +import Range +-- | Extract document symbols for some specific parsed ligo contract which +-- is realisable by @haskell-lsp@ client. +extractDocumentSymbols + :: forall m. + (MonadCatch m) + => J.Uri + -> LIGO Info' + -> m [SymbolInformation] +extractDocumentSymbols uri tree = execWriterT . visit handlers $ tree + where + handlers = + [ Visit @Binding $ \case + (_, Function _ (match @Name -> Just (getElem @Range -> r, _)) _ _ _)-> + tellScopedDecl + r + J.SkFunction + (\_ -> Nothing) + + -- TODO: currently we do not count imports as declarations in scopes + (_, Include (match @Constant -> Just (getElem @Range -> r, _))) -> + tellSymbolInfo + r + J.SkNamespace + ("some import at " <> pack (show r)) + + (_, TypeDecl (match @TypeName -> Just (getElem @Range -> r, _)) _) -> + tellScopedDecl + r + J.SkTypeParameter + (\_ -> Nothing) + + (_, Const (match @Name -> Just (getElem @Range -> r, _)) _ _) -> + tellScopedDecl + r + J.SkConstant + (\ScopedDecl {_sdName} -> Just ("const " <> _sdName)) + + (_, Var (match @Name -> Just (getElem @Range -> r, _)) _ _) -> + tellScopedDecl + r + J.SkVariable + (\ScopedDecl {_sdName} -> Just ("var " <> _sdName)) + + _ -> pure () + ] + + -- | Tries to find scoped declaration and apply continuation to it or + -- ignore the declaration if not found. + withScopedDecl + :: Range + -> (ScopedDecl -> WriterT [SymbolInformation] m ()) + -> WriterT [SymbolInformation] m () + withScopedDecl r f = maybe (pure ()) f (findScopedDecl r tree) + + -- | Tell to the writer symbol information that we may find in scope or + -- just ignore it and return `[]`. + tellScopedDecl + :: Range + -> J.SymbolKind + -> (ScopedDecl -> Maybe Text) + -> WriterT [SymbolInformation] m () + tellScopedDecl range kind mkName = + withScopedDecl range $ \sd@ScopedDecl{..} -> + tell + [ SymbolInformation + { _name = fromMaybe _sdName (mkName sd) + , _deprecated = Nothing + , _kind = kind + , _containerName = matchContainerName kind + , _location = J.Location uri $ toLSPRange range + } + ] + + -- | Tell to the writer some arbitrary symbol info. This is similar to + -- @tellScopedDecl@ but it does not search for symbol in scope and always + -- returns non-empty value. + tellSymbolInfo + :: Range + -> J.SymbolKind + -> Text + -> WriterT [SymbolInformation] m () + tellSymbolInfo range kind name = + tell + [ SymbolInformation + { _name = name + , _deprecated = Nothing + , _kind = kind + , _containerName = matchContainerName kind + , _location = J.Location uri $ toLSPRange range + } + ] + + -- | Helper function that associates container name with its container type + -- defined for the sole purpose of minimising the amount of arguments for `tellScopedDecl`. + matchContainerName = \case + J.SkTypeParameter -> Just "type" + J.SkNamespace -> Just "import" + J.SkConstant -> Just "const declaration" + J.SkVariable -> Just "var declaration" + J.SkFunction -> Just "function" + _ -> Nothing diff --git a/tools/lsp/squirrel/src/Range.hs b/tools/lsp/squirrel/src/Range.hs index 957aa7ee2..fe057c68b 100644 --- a/tools/lsp/squirrel/src/Range.hs +++ b/tools/lsp/squirrel/src/Range.hs @@ -58,13 +58,14 @@ instance Contains Range xs => HasRange (Product xs) where getRange = getElem -- | Convert `squirrel` range to `haskell-lsp` range. +-- Note that we consider the first line to be at position 1. toLSPRange :: Range -> LSP.Range toLSPRange Range { rStart = (rsl, rsc, _) , rFinish = (rfl, rfc, _) } = LSP.Range - { LSP._start = LSP.Position { LSP._line = rsl, LSP._character = rsc } - , LSP._end = LSP.Position { LSP._line = rfl, LSP._character = rfc } + { LSP._start = LSP.Position { LSP._line = rsl - 1, LSP._character = rsc } + , LSP._end = LSP.Position { LSP._line = rfl - 1, LSP._character = rfc } } -- | Extract textual representation of given range.