From d49a00048a068f7010127a5587426de14fcf3601 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 10 Jun 2024 18:06:30 +0300 Subject: [PATCH 01/22] working test message cabal file --- ghcide/src/Development/IDE/LSP/Outline.hs | 2 +- haskell-language-server.cabal | 1 + .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 2 + .../src/Ide/Plugin/Cabal/Outline.hs | 50 +++++++++++++++++++ 4 files changed, 54 insertions(+), 1 deletion(-) create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 8d466a61a6..1d12b16f1c 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -26,7 +26,7 @@ import Language.LSP.Protocol.Types (DocumentSymbol (..), DocumentSymbolParams (DocumentSymbolParams, _textDocument), SymbolKind (..), TextDocumentIdentifier (TextDocumentIdentifier), - type (|?) (InL, InR), uriToFilePath) + type (|?) (InL, InR), uriToFilePath, mkRange, SymbolInformation (_deprecated)) import Language.LSP.Protocol.Message -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index a28467e634..43025bddb4 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -242,6 +242,7 @@ library hls-cabal-plugin Ide.Plugin.Cabal.Completion.Types Ide.Plugin.Cabal.LicenseSuggest Ide.Plugin.Cabal.Orphans + Ide.Plugin.Cabal.Outline Ide.Plugin.Cabal.Parse diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index c483ddc1d5..d04a06da8a 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -39,6 +39,7 @@ import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest import Ide.Plugin.Cabal.Orphans () import qualified Ide.Plugin.Cabal.Parse as Parse +import Ide.Plugin.Cabal.Outline import Ide.Types import qualified Language.LSP.Protocol.Lens as JL import qualified Language.LSP.Protocol.Message as LSP @@ -88,6 +89,7 @@ descriptor recorder plId = mconcat [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction , mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder + , mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline ] , pluginNotificationHandlers = mconcat diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs new file mode 100644 index 0000000000..afca0dabd9 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE CPP #-} + +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GADTs #-} + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + + +module Ide.Plugin.Cabal.Outline + ( moduleOutline + ) +where + +import Control.Monad.IO.Class +import Data.Foldable (toList) +import Data.Functor +import Data.List.NonEmpty (nonEmpty) +import Data.Maybe +import Development.IDE.Core.Rules +import Development.IDE.Core.Shake +import Development.IDE.GHC.Compat +import Development.IDE.GHC.Error (rangeToRealSrcSpan, + realSrcSpanToRange) +import Development.IDE.Types.Location +import Development.IDE.GHC.Util (printOutputable) +import Ide.Types +import Language.LSP.Protocol.Types (DocumentSymbol (..), + DocumentSymbolParams (DocumentSymbolParams, _textDocument), + SymbolKind (..), + TextDocumentIdentifier (TextDocumentIdentifier), + type (|?) (InL, InR), uriToFilePath, mkRange, SymbolInformation (_deprecated)) +import Language.LSP.Protocol.Message + ( Method(Method_TextDocumentDocumentSymbol) ) + +import qualified Data.Text as T + +moduleOutline :: PluginMethodHandler IdeState Method_TextDocumentDocumentSymbol +moduleOutline ideState _ DocumentSymbolParams{ _textDocument = TextDocumentIdentifier uri } + = liftIO $ case uriToFilePath uri of + Just (toNormalizedFilePath' -> fp) -> pure $ InR (InL [DocumentSymbol {_name="hello!" + ,_detail=Nothing + ,_kind=SymbolKind_Module + ,_tags=Nothing + ,_range=mkRange 1 0 1 11 + ,_deprecated=Nothing + ,_selectionRange=mkRange 1 0 1 11 + ,_children=Nothing}]) + Nothing -> pure $ InL [] \ No newline at end of file From 632f5a036fe54ca6034538358d5e69c08ae8c81f Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Sat, 15 Jun 2024 00:15:58 +0300 Subject: [PATCH 02/22] trivial outline with rule invocation --- .../src/Ide/Plugin/Cabal/Outline.hs | 83 ++++++++++++------- 1 file changed, 55 insertions(+), 28 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs index afca0dabd9..834fd74642 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -6,6 +6,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Ide.Plugin.Cabal.Outline @@ -14,37 +15,63 @@ module Ide.Plugin.Cabal.Outline where import Control.Monad.IO.Class -import Data.Foldable (toList) -import Data.Functor -import Data.List.NonEmpty (nonEmpty) import Data.Maybe import Development.IDE.Core.Rules -import Development.IDE.Core.Shake -import Development.IDE.GHC.Compat -import Development.IDE.GHC.Error (rangeToRealSrcSpan, - realSrcSpanToRange) -import Development.IDE.Types.Location -import Development.IDE.GHC.Util (printOutputable) +import Development.IDE.Core.Shake ( IdeState(shakeExtras), runIdeAction, useWithStaleFast ) +import Development.IDE.Types.Location ( toNormalizedFilePath') import Ide.Types -import Language.LSP.Protocol.Types (DocumentSymbol (..), - DocumentSymbolParams (DocumentSymbolParams, _textDocument), - SymbolKind (..), - TextDocumentIdentifier (TextDocumentIdentifier), - type (|?) (InL, InR), uriToFilePath, mkRange, SymbolInformation (_deprecated)) -import Language.LSP.Protocol.Message - ( Method(Method_TextDocumentDocumentSymbol) ) +import qualified Language.LSP.Protocol.Types as LSP +import qualified Language.LSP.Protocol.Message as LSP + +import Data.Text.Encoding (decodeASCII) + +import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..)) +import Ide.Plugin.Cabal.Orphans () + +import Distribution.Fields.Field (Field (Field), Name (Name)) +import Distribution.Parsec.Position (Position (Position)) import qualified Data.Text as T +import Debug.Trace as Debug + +moduleOutline :: PluginMethodHandler IdeState LSP.Method_TextDocumentDocumentSymbol +moduleOutline ideState _ LSP.DocumentSymbolParams{ _textDocument = LSP.TextDocumentIdentifier uri } + = case LSP.uriToFilePath uri of + Just (toNormalizedFilePath' -> fp) -> do + mFields <- liftIO $ runIdeAction "cabal-plugin.fields" (shakeExtras ideState) (useWithStaleFast ParseCabalFields fp) + let debug = fmap fst mFields + -- Debug.traceShowM debug + case fmap fst mFields of + Just fieldPositions -> pure $ LSP.InR (LSP.InL allSymbols) + where + allSymbols = mapMaybe documentSymbolForField fieldPositions + -- pure $ InR (InL [DocumentSymbol {_name="hello!" + -- ,_detail=Nothing + -- ,_kind=SymbolKind_Module + -- ,_tags=Nothing + -- ,_range=mkRange 1 0 1 11 + -- ,_deprecated=Nothing + -- ,_selectionRange=mkRange 1 0 1 11 + -- ,_children=Nothing}]) + Nothing -> pure $ LSP.InL [] + Nothing -> pure $ LSP.InL [] + +documentSymbolForField :: Field Position -> Maybe LSP.DocumentSymbol +documentSymbolForField (Field (Name pos@(Position line char) fieldName) _ )= Just $ LSP.DocumentSymbol { .. } where + _detail = Nothing + _deprecated = Nothing + _name = decodeASCII fieldName + + _kind = LSP.SymbolKind_Field + _range = LSP.Range (parserToLSPPosition pos) (parserToLSPPosition (Position line char)) + _selectionRange = LSP.Range (parserToLSPPosition pos) (parserToLSPPosition (Position line char)) + _children = Nothing + _tags = Nothing + + -- addNameLength :: UInt -> FieldName -> UInt + -- addNameLength char name = toEnum (fromEnum char + length name) +documentSymbolForField _ = Nothing + -moduleOutline :: PluginMethodHandler IdeState Method_TextDocumentDocumentSymbol -moduleOutline ideState _ DocumentSymbolParams{ _textDocument = TextDocumentIdentifier uri } - = liftIO $ case uriToFilePath uri of - Just (toNormalizedFilePath' -> fp) -> pure $ InR (InL [DocumentSymbol {_name="hello!" - ,_detail=Nothing - ,_kind=SymbolKind_Module - ,_tags=Nothing - ,_range=mkRange 1 0 1 11 - ,_deprecated=Nothing - ,_selectionRange=mkRange 1 0 1 11 - ,_children=Nothing}]) - Nothing -> pure $ InL [] \ No newline at end of file +parserToLSPPosition :: Position -> LSP.Position +parserToLSPPosition (Position start end) = LSP.Position (toEnum start) (toEnum end) \ No newline at end of file From 35741655dcc09fbe0f0cd7358f6efc1e7863c49e Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Sat, 15 Jun 2024 20:24:04 +0300 Subject: [PATCH 03/22] outline with field lines --- .../src/Ide/Plugin/Cabal/Completion/Types.hs | 3 + .../src/Ide/Plugin/Cabal/Outline.hs | 107 +++++++++--------- 2 files changed, 58 insertions(+), 52 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs index c39362e826..bbe1467a9d 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs @@ -171,3 +171,6 @@ lspPositionToCabalPosition :: Position -> Syntax.Position lspPositionToCabalPosition pos = Syntax.Position (fromIntegral (pos ^. JL.line) + 1) (fromIntegral (pos ^. JL.character) + 1) + +cabalPositionToLSPPosition :: Syntax.Position -> Position +cabalPositionToLSPPosition (Syntax.Position start end) = Position (toEnum start -1) (toEnum end -1) \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs index 834fd74642..087e30c53b 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -1,42 +1,35 @@ -{-# LANGUAGE CPP #-} - +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE GADTs #-} - -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} - +{-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Cabal.Outline - ( moduleOutline - ) + ( moduleOutline, + ) where -import Control.Monad.IO.Class -import Data.Maybe -import Development.IDE.Core.Rules -import Development.IDE.Core.Shake ( IdeState(shakeExtras), runIdeAction, useWithStaleFast ) -import Development.IDE.Types.Location ( toNormalizedFilePath') -import Ide.Types -import qualified Language.LSP.Protocol.Types as LSP -import qualified Language.LSP.Protocol.Message as LSP - -import Data.Text.Encoding (decodeASCII) - -import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..)) -import Ide.Plugin.Cabal.Orphans () - -import Distribution.Fields.Field (Field (Field), Name (Name)) -import Distribution.Parsec.Position (Position (Position)) - -import qualified Data.Text as T -import Debug.Trace as Debug +import Control.Monad.IO.Class +import Data.Maybe +import Data.Text qualified as T +import Data.Text.Encoding (decodeASCII, decodeLatin1) +import Debug.Trace as Debug +import Development.IDE.Core.Rules +import Development.IDE.Core.Shake (IdeState (shakeExtras), runIdeAction, useWithStaleFast) +import Development.IDE.Types.Location (toNormalizedFilePath') +import Distribution.Fields.Field (Field (Field), Name (Name), FieldName, FieldLine(FieldLine)) +import Distribution.Parsec.Position (Position (Position)) +import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), cabalPositionToLSPPosition) +import Ide.Plugin.Cabal.Orphans () +import Ide.Types +import Language.LSP.Protocol.Message qualified as LSP +import Language.LSP.Protocol.Types qualified as LSP moduleOutline :: PluginMethodHandler IdeState LSP.Method_TextDocumentDocumentSymbol -moduleOutline ideState _ LSP.DocumentSymbolParams{ _textDocument = LSP.TextDocumentIdentifier uri } - = case LSP.uriToFilePath uri of +moduleOutline ideState _ LSP.DocumentSymbolParams {_textDocument = LSP.TextDocumentIdentifier uri} = + case LSP.uriToFilePath uri of Just (toNormalizedFilePath' -> fp) -> do mFields <- liftIO $ runIdeAction "cabal-plugin.fields" (shakeExtras ideState) (useWithStaleFast ParseCabalFields fp) let debug = fmap fst mFields @@ -45,33 +38,43 @@ moduleOutline ideState _ LSP.DocumentSymbolParams{ _textDocument = LSP.TextDocum Just fieldPositions -> pure $ LSP.InR (LSP.InL allSymbols) where allSymbols = mapMaybe documentSymbolForField fieldPositions - -- pure $ InR (InL [DocumentSymbol {_name="hello!" - -- ,_detail=Nothing - -- ,_kind=SymbolKind_Module - -- ,_tags=Nothing - -- ,_range=mkRange 1 0 1 11 - -- ,_deprecated=Nothing - -- ,_selectionRange=mkRange 1 0 1 11 - -- ,_children=Nothing}]) Nothing -> pure $ LSP.InL [] Nothing -> pure $ LSP.InL [] documentSymbolForField :: Field Position -> Maybe LSP.DocumentSymbol -documentSymbolForField (Field (Name pos@(Position line char) fieldName) _ )= Just $ LSP.DocumentSymbol { .. } where - _detail = Nothing - _deprecated = Nothing - _name = decodeASCII fieldName +documentSymbolForField (Field (Name pos fieldName) fieldLines) = Just $ LSP.DocumentSymbol {..} + where + _detail = Nothing + _deprecated = Nothing + _name = decodeASCII fieldName - _kind = LSP.SymbolKind_Field - _range = LSP.Range (parserToLSPPosition pos) (parserToLSPPosition (Position line char)) - _selectionRange = LSP.Range (parserToLSPPosition pos) (parserToLSPPosition (Position line char)) - _children = Nothing - _tags = Nothing + _kind = LSP.SymbolKind_Field + _range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII fieldName + _selectionRange = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII fieldName + _children = Just $ mapMaybe documentSymbolForFieldLine fieldLines + _tags = Nothing - -- addNameLength :: UInt -> FieldName -> UInt - -- addNameLength char name = toEnum (fromEnum char + length name) documentSymbolForField _ = Nothing +documentSymbolForFieldLine :: FieldLine Position -> Maybe LSP.DocumentSymbol +documentSymbolForFieldLine (FieldLine pos line) = Just $ LSP.DocumentSymbol {..} + where + _detail = Nothing + _deprecated = Nothing + _name = decodeLatin1 line -- since there is no ascii invariant (?) + + _kind = LSP.SymbolKind_Field + _range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII line + _selectionRange = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII line + _children = Nothing + _tags = Nothing + +cabalPositionToLSPRange :: Position -> LSP.Range +cabalPositionToLSPRange pos = LSP.Range lspPos lspPos + where lspPos = cabalPositionToLSPPosition pos -parserToLSPPosition :: Position -> LSP.Position -parserToLSPPosition (Position start end) = LSP.Position (toEnum start) (toEnum end) \ No newline at end of file +addNameLengthToLSPRange :: LSP.Range -> T.Text -> LSP.Range +addNameLengthToLSPRange (LSP.Range pos1 (LSP.Position line char)) name = + LSP.Range + pos1 + (LSP.Position line (char + fromIntegral (T.length name))) \ No newline at end of file From 965d61bd62b046bbcbb68d3e2e2d276855404759 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Sat, 15 Jun 2024 23:56:30 +0300 Subject: [PATCH 04/22] complete outline prototype --- .../src/Ide/Plugin/Cabal/Outline.hs | 111 +++++++++++++----- 1 file changed, 81 insertions(+), 30 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs index 087e30c53b..d412dfb516 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -15,12 +15,16 @@ import Control.Monad.IO.Class import Data.Maybe import Data.Text qualified as T import Data.Text.Encoding (decodeASCII, decodeLatin1) -import Debug.Trace as Debug import Development.IDE.Core.Rules import Development.IDE.Core.Shake (IdeState (shakeExtras), runIdeAction, useWithStaleFast) import Development.IDE.Types.Location (toNormalizedFilePath') -import Distribution.Fields.Field (Field (Field), Name (Name), FieldName, FieldLine(FieldLine)) -import Distribution.Parsec.Position (Position (Position)) +import Distribution.Fields.Field + ( Field (Field, Section), + FieldLine (FieldLine), + Name (Name), + SectionArg (SecArgName, SecArgOther, SecArgStr), + ) +import Distribution.Parsec.Position (Position) import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), cabalPositionToLSPPosition) import Ide.Plugin.Cabal.Orphans () import Ide.Types @@ -32,8 +36,6 @@ moduleOutline ideState _ LSP.DocumentSymbolParams {_textDocument = LSP.TextDocum case LSP.uriToFilePath uri of Just (toNormalizedFilePath' -> fp) -> do mFields <- liftIO $ runIdeAction "cabal-plugin.fields" (shakeExtras ideState) (useWithStaleFast ParseCabalFields fp) - let debug = fmap fst mFields - -- Debug.traceShowM debug case fmap fst mFields of Just fieldPositions -> pure $ LSP.InR (LSP.InL allSymbols) where @@ -42,39 +44,88 @@ moduleOutline ideState _ LSP.DocumentSymbolParams {_textDocument = LSP.TextDocum Nothing -> pure $ LSP.InL [] documentSymbolForField :: Field Position -> Maybe LSP.DocumentSymbol -documentSymbolForField (Field (Name pos fieldName) fieldLines) = Just $ LSP.DocumentSymbol {..} +documentSymbolForField (Field (Name pos fieldName) fieldLines) = + Just + (defDocumentSymbol range) + { LSP._name = decodeASCII fieldName, + LSP._kind = LSP.SymbolKind_Object, + LSP._children = Just $ mapMaybe documentSymbolForFieldLine fieldLines + } where - _detail = Nothing - _deprecated = Nothing - _name = decodeASCII fieldName - - _kind = LSP.SymbolKind_Field - _range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII fieldName - _selectionRange = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII fieldName - _children = Just $ mapMaybe documentSymbolForFieldLine fieldLines - _tags = Nothing + range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII fieldName +documentSymbolForField (Section (Name pos fieldName) sectionArgs fields) = + Just + (defDocumentSymbol range) + { LSP._name = decodeASCII fieldName, + LSP._kind = LSP.SymbolKind_Object, + LSP._children = + Just + ( mapMaybe documentSymbolForField fields + ++ mapMaybe documentSymbolForSectionArgs sectionArgs + ) + } + where + range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII fieldName -documentSymbolForField _ = Nothing +documentSymbolForSectionArgs :: SectionArg Position -> Maybe LSP.DocumentSymbol +documentSymbolForSectionArgs (SecArgName pos identifier) = + Just + (defDocumentSymbol range) + { LSP._name = decodeLatin1 identifier, + LSP._kind = LSP.SymbolKind_Variable, + LSP._children = Nothing + } + where + range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII identifier +documentSymbolForSectionArgs (SecArgStr pos quotedString) = + Just + (defDocumentSymbol range) + { LSP._name = decodeLatin1 quotedString, + LSP._kind = LSP.SymbolKind_Constant, + LSP._children = Nothing + } + where + range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII quotedString +documentSymbolForSectionArgs (SecArgOther pos string) = + Just + (defDocumentSymbol range) + { LSP._name = decodeLatin1 string, + LSP._kind = LSP.SymbolKind_String, + LSP._children = Nothing + } + where + range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII string documentSymbolForFieldLine :: FieldLine Position -> Maybe LSP.DocumentSymbol -documentSymbolForFieldLine (FieldLine pos line) = Just $ LSP.DocumentSymbol {..} +documentSymbolForFieldLine (FieldLine pos line) = + Just + (defDocumentSymbol range) + { LSP._name = decodeLatin1 line, -- since there is no ascii invariant (?) + LSP._kind = LSP.SymbolKind_Field, + LSP._children = Nothing -- can't delete even though the base case covers this (?) + } where - _detail = Nothing - _deprecated = Nothing - _name = decodeLatin1 line -- since there is no ascii invariant (?) - - _kind = LSP.SymbolKind_Field - _range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII line - _selectionRange = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII line - _children = Nothing - _tags = Nothing + range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII line cabalPositionToLSPRange :: Position -> LSP.Range cabalPositionToLSPRange pos = LSP.Range lspPos lspPos - where lspPos = cabalPositionToLSPPosition pos + where + lspPos = cabalPositionToLSPPosition pos addNameLengthToLSPRange :: LSP.Range -> T.Text -> LSP.Range addNameLengthToLSPRange (LSP.Range pos1 (LSP.Position line char)) name = - LSP.Range - pos1 - (LSP.Position line (char + fromIntegral (T.length name))) \ No newline at end of file + LSP.Range + pos1 + (LSP.Position line (char + fromIntegral (T.length name))) + +defDocumentSymbol :: LSP.Range -> LSP.DocumentSymbol +defDocumentSymbol range = LSP.DocumentSymbol {..} + where + _detail = Nothing + _deprecated = Nothing + _name = "" + _kind = LSP.SymbolKind_File + _range = range + _selectionRange = range + _children = Nothing + _tags = Nothing \ No newline at end of file From fd0b2eace9b151f5103e279fc8efb79a62689877 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 18 Jun 2024 13:58:38 +0300 Subject: [PATCH 05/22] small improvements --- .../src/Ide/Plugin/Cabal/Outline.hs | 35 ++++++++++--------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs index d412dfb516..9af61e21d6 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -14,7 +14,7 @@ where import Control.Monad.IO.Class import Data.Maybe import Data.Text qualified as T -import Data.Text.Encoding (decodeASCII, decodeLatin1) +import Data.Text.Encoding (decodeUtf8) import Development.IDE.Core.Rules import Development.IDE.Core.Shake (IdeState (shakeExtras), runIdeAction, useWithStaleFast) import Development.IDE.Types.Location (toNormalizedFilePath') @@ -27,7 +27,7 @@ import Distribution.Fields.Field import Distribution.Parsec.Position (Position) import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), cabalPositionToLSPPosition) import Ide.Plugin.Cabal.Orphans () -import Ide.Types +import Ide.Types ( PluginMethodHandler ) import Language.LSP.Protocol.Message qualified as LSP import Language.LSP.Protocol.Types qualified as LSP @@ -47,16 +47,16 @@ documentSymbolForField :: Field Position -> Maybe LSP.DocumentSymbol documentSymbolForField (Field (Name pos fieldName) fieldLines) = Just (defDocumentSymbol range) - { LSP._name = decodeASCII fieldName, - LSP._kind = LSP.SymbolKind_Object, + { LSP._name = decodeUtf8 fieldName, + LSP._kind = LSP.SymbolKind_Field, LSP._children = Just $ mapMaybe documentSymbolForFieldLine fieldLines } where - range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII fieldName + range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 fieldName documentSymbolForField (Section (Name pos fieldName) sectionArgs fields) = Just (defDocumentSymbol range) - { LSP._name = decodeASCII fieldName, + { LSP._name = decodeUtf8 fieldName, LSP._kind = LSP.SymbolKind_Object, LSP._children = Just @@ -65,48 +65,51 @@ documentSymbolForField (Section (Name pos fieldName) sectionArgs fields) = ) } where - range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII fieldName + range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 fieldName documentSymbolForSectionArgs :: SectionArg Position -> Maybe LSP.DocumentSymbol documentSymbolForSectionArgs (SecArgName pos identifier) = Just (defDocumentSymbol range) - { LSP._name = decodeLatin1 identifier, + { LSP._name = decodeUtf8 identifier, LSP._kind = LSP.SymbolKind_Variable, LSP._children = Nothing } where - range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII identifier + range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 identifier documentSymbolForSectionArgs (SecArgStr pos quotedString) = Just (defDocumentSymbol range) - { LSP._name = decodeLatin1 quotedString, + { LSP._name = decodeUtf8 quotedString, LSP._kind = LSP.SymbolKind_Constant, LSP._children = Nothing } where - range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII quotedString + range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 quotedString documentSymbolForSectionArgs (SecArgOther pos string) = Just (defDocumentSymbol range) - { LSP._name = decodeLatin1 string, + { LSP._name = decodeUtf8 string, LSP._kind = LSP.SymbolKind_String, LSP._children = Nothing } where - range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII string + range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 string documentSymbolForFieldLine :: FieldLine Position -> Maybe LSP.DocumentSymbol documentSymbolForFieldLine (FieldLine pos line) = Just (defDocumentSymbol range) - { LSP._name = decodeLatin1 line, -- since there is no ascii invariant (?) + { LSP._name = decodeUtf8 line, LSP._kind = LSP.SymbolKind_Field, - LSP._children = Nothing -- can't delete even though the base case covers this (?) + LSP._children = Nothing } where - range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeASCII line + range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 line + +-- | Creates a single point LSP range +-- using cabal position cabalPositionToLSPRange :: Position -> LSP.Range cabalPositionToLSPRange pos = LSP.Range lspPos lspPos where From a5e7e53c15b546d330bc738f3218524c183820ac Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 18 Jun 2024 15:00:16 +0300 Subject: [PATCH 06/22] remove fieldLines, one line Section display --- .../src/Ide/Plugin/Cabal/Outline.hs | 65 +++++-------------- 1 file changed, 18 insertions(+), 47 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs index 9af61e21d6..ac0677714f 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -24,10 +24,10 @@ import Distribution.Fields.Field Name (Name), SectionArg (SecArgName, SecArgOther, SecArgStr), ) -import Distribution.Parsec.Position (Position) +import Distribution.Parsec.Position (Position (Position)) import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), cabalPositionToLSPPosition) import Ide.Plugin.Cabal.Orphans () -import Ide.Types ( PluginMethodHandler ) +import Ide.Types (PluginMethodHandler) import Language.LSP.Protocol.Message qualified as LSP import Language.LSP.Protocol.Types qualified as LSP @@ -43,70 +43,41 @@ moduleOutline ideState _ LSP.DocumentSymbolParams {_textDocument = LSP.TextDocum Nothing -> pure $ LSP.InL [] Nothing -> pure $ LSP.InL [] +-- | Creates a DocumentSumbol object for the +-- cabal AST, without displaying fieldLines and +-- displaying Section name and SectionArgs in one line documentSymbolForField :: Field Position -> Maybe LSP.DocumentSymbol -documentSymbolForField (Field (Name pos fieldName) fieldLines) = +documentSymbolForField (Field (Name pos fieldName) _) = Just (defDocumentSymbol range) { LSP._name = decodeUtf8 fieldName, LSP._kind = LSP.SymbolKind_Field, - LSP._children = Just $ mapMaybe documentSymbolForFieldLine fieldLines + LSP._children = Nothing } where range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 fieldName documentSymbolForField (Section (Name pos fieldName) sectionArgs fields) = Just (defDocumentSymbol range) - { LSP._name = decodeUtf8 fieldName, + { LSP._name = joinedName, LSP._kind = LSP.SymbolKind_Object, LSP._children = Just - ( mapMaybe documentSymbolForField fields - ++ mapMaybe documentSymbolForSectionArgs sectionArgs - ) - } - where - range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 fieldName - -documentSymbolForSectionArgs :: SectionArg Position -> Maybe LSP.DocumentSymbol -documentSymbolForSectionArgs (SecArgName pos identifier) = - Just - (defDocumentSymbol range) - { LSP._name = decodeUtf8 identifier, - LSP._kind = LSP.SymbolKind_Variable, - LSP._children = Nothing - } - where - range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 identifier -documentSymbolForSectionArgs (SecArgStr pos quotedString) = - Just - (defDocumentSymbol range) - { LSP._name = decodeUtf8 quotedString, - LSP._kind = LSP.SymbolKind_Constant, - LSP._children = Nothing - } - where - range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 quotedString -documentSymbolForSectionArgs (SecArgOther pos string) = - Just - (defDocumentSymbol range) - { LSP._name = decodeUtf8 string, - LSP._kind = LSP.SymbolKind_String, - LSP._children = Nothing + (mapMaybe documentSymbolForField fields) } where - range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 string + joinedName = decodeUtf8 fieldName <> " " <> joinedNameForSectionArgs sectionArgs + range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` joinedName -documentSymbolForFieldLine :: FieldLine Position -> Maybe LSP.DocumentSymbol -documentSymbolForFieldLine (FieldLine pos line) = - Just - (defDocumentSymbol range) - { LSP._name = decodeUtf8 line, - LSP._kind = LSP.SymbolKind_Field, - LSP._children = Nothing - } +joinedNameForSectionArgs :: [SectionArg Position] -> T.Text +joinedNameForSectionArgs sectionArgs = joinedName where - range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 line + joinedName = T.unwords $ map getName sectionArgs + getName :: SectionArg Position -> T.Text + getName (SecArgName _ identifier) = decodeUtf8 identifier + getName (SecArgStr _ quotedString) = decodeUtf8 quotedString + getName (SecArgOther _ string) = decodeUtf8 string -- | Creates a single point LSP range -- using cabal position From d616c54828fb74547b97c54dbca862be98b1fbfe Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 18 Jun 2024 16:59:52 +0300 Subject: [PATCH 07/22] stylish haskell --- ghcide/src/Development/IDE/LSP/Outline.hs | 2 +- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 2 +- .../src/Ide/Plugin/Cabal/Completion/Types.hs | 2 +- .../src/Ide/Plugin/Cabal/Outline.hs | 56 +++++++++---------- 4 files changed, 31 insertions(+), 31 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 1d12b16f1c..8d466a61a6 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -26,7 +26,7 @@ import Language.LSP.Protocol.Types (DocumentSymbol (..), DocumentSymbolParams (DocumentSymbolParams, _textDocument), SymbolKind (..), TextDocumentIdentifier (TextDocumentIdentifier), - type (|?) (InL, InR), uriToFilePath, mkRange, SymbolInformation (_deprecated)) + type (|?) (InL, InR), uriToFilePath) import Language.LSP.Protocol.Message -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index d04a06da8a..f2a7cead59 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -38,8 +38,8 @@ import qualified Ide.Plugin.Cabal.Completion.Types as Types import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest import Ide.Plugin.Cabal.Orphans () -import qualified Ide.Plugin.Cabal.Parse as Parse import Ide.Plugin.Cabal.Outline +import qualified Ide.Plugin.Cabal.Parse as Parse import Ide.Types import qualified Language.LSP.Protocol.Lens as JL import qualified Language.LSP.Protocol.Message as LSP diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs index bbe1467a9d..a77aea0578 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs @@ -173,4 +173,4 @@ lspPositionToCabalPosition pos = Syntax.Position (fromIntegral (pos ^. JL.character) + 1) cabalPositionToLSPPosition :: Syntax.Position -> Position -cabalPositionToLSPPosition (Syntax.Position start end) = Position (toEnum start -1) (toEnum end -1) \ No newline at end of file +cabalPositionToLSPPosition (Syntax.Position start end) = Position (toEnum start -1) (toEnum end -1) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs index ac0677714f..1611acef62 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -1,35 +1,35 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Cabal.Outline ( moduleOutline, ) where -import Control.Monad.IO.Class -import Data.Maybe -import Data.Text qualified as T -import Data.Text.Encoding (decodeUtf8) -import Development.IDE.Core.Rules -import Development.IDE.Core.Shake (IdeState (shakeExtras), runIdeAction, useWithStaleFast) -import Development.IDE.Types.Location (toNormalizedFilePath') -import Distribution.Fields.Field - ( Field (Field, Section), - FieldLine (FieldLine), - Name (Name), - SectionArg (SecArgName, SecArgOther, SecArgStr), - ) -import Distribution.Parsec.Position (Position (Position)) -import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), cabalPositionToLSPPosition) -import Ide.Plugin.Cabal.Orphans () -import Ide.Types (PluginMethodHandler) -import Language.LSP.Protocol.Message qualified as LSP -import Language.LSP.Protocol.Types qualified as LSP +import Control.Monad.IO.Class +import Data.Maybe +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8) +import Development.IDE.Core.Rules +import Development.IDE.Core.Shake (IdeState (shakeExtras), + runIdeAction, + useWithStaleFast) +import Development.IDE.Types.Location (toNormalizedFilePath') +import Distribution.Fields.Field (Field (Field, Section), + Name (Name), + SectionArg (SecArgName, SecArgOther, SecArgStr)) +import Distribution.Parsec.Position (Position) +import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), + cabalPositionToLSPPosition) +import Ide.Plugin.Cabal.Orphans () +import Ide.Types (PluginMethodHandler) +import qualified Language.LSP.Protocol.Message as LSP +import qualified Language.LSP.Protocol.Types as LSP moduleOutline :: PluginMethodHandler IdeState LSP.Method_TextDocumentDocumentSymbol moduleOutline ideState _ LSP.DocumentSymbolParams {_textDocument = LSP.TextDocumentIdentifier uri} = @@ -75,9 +75,9 @@ joinedNameForSectionArgs sectionArgs = joinedName joinedName = T.unwords $ map getName sectionArgs getName :: SectionArg Position -> T.Text - getName (SecArgName _ identifier) = decodeUtf8 identifier + getName (SecArgName _ identifier) = decodeUtf8 identifier getName (SecArgStr _ quotedString) = decodeUtf8 quotedString - getName (SecArgOther _ string) = decodeUtf8 string + getName (SecArgOther _ string) = decodeUtf8 string -- | Creates a single point LSP range -- using cabal position @@ -102,4 +102,4 @@ defDocumentSymbol range = LSP.DocumentSymbol {..} _range = range _selectionRange = range _children = Nothing - _tags = Nothing \ No newline at end of file + _tags = Nothing From a953ecb97e157e70b4f07c6913c0a9196ca224b9 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Fri, 21 Jun 2024 18:45:58 +0300 Subject: [PATCH 08/22] tests --- haskell-language-server.cabal | 1 + .../src/Ide/Plugin/Cabal/Outline.hs | 5 +- plugins/hls-cabal-plugin/test/Main.hs | 2 + plugins/hls-cabal-plugin/test/Outline.hs | 70 +++++++++++++++++++ .../test/testdata/outline-cabal/field.cabal | 1 + .../testdata/outline-cabal/fieldline.cabal | 1 + .../test/testdata/outline-cabal/section.cabal | 2 + .../testdata/outline-cabal/sectionarg.cabal | 2 + 8 files changed, 80 insertions(+), 4 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/Outline.hs create mode 100644 plugins/hls-cabal-plugin/test/testdata/outline-cabal/field.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/outline-cabal/fieldline.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/outline-cabal/section.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/outline-cabal/sectionarg.cabal diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 43025bddb4..7b44914197 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -281,6 +281,7 @@ test-suite hls-cabal-plugin-tests Completer Context Utils + Outline build-depends: , base , bytestring diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs index 1611acef62..8b2f43c9f2 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -6,10 +6,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} -module Ide.Plugin.Cabal.Outline - ( moduleOutline, - ) -where +module Ide.Plugin.Cabal.Outline where import Control.Monad.IO.Class import Data.Maybe diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 132abb5162..c2d341015f 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -16,6 +16,7 @@ import qualified Data.Text as Text import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) import qualified Ide.Plugin.Cabal.Parse as Lib import qualified Language.LSP.Protocol.Lens as L +import Outline (outlineTests) import System.FilePath import Test.Hls import Utils @@ -29,6 +30,7 @@ main = do , pluginTests , completerTests , contextTests + , outlineTests ] -- ------------------------------------------------------------------------ diff --git a/plugins/hls-cabal-plugin/test/Outline.hs b/plugins/hls-cabal-plugin/test/Outline.hs new file mode 100644 index 0000000000..0e9e8582a5 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/Outline.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} + +module Outline ( + outlineTests +) where + +import qualified Ide.Plugin.Cabal.Outline as Outline +import qualified Language.LSP.Protocol.Types as LSP +import Test.Hls +import Utils + +testSymbols :: (HasCallStack) => TestName -> FilePath -> [DocumentSymbol] -> TestTree +testSymbols testName path expectedSymbols = + runCabalTestCaseSession testName "outline-cabal" $ do + docId <- openDoc path "cabal" + symbols <- getDocumentSymbols docId + liftIO $ symbols @?= Right expectedSymbols + +outlineTests :: TestTree +outlineTests = + testGroup + "Cabal Outline Tests" + [ testSymbols + "cabal Field outline test" + "field.cabal" + [fieldDocumentSymbol], + testSymbols + "cabal FieldLine outline test" + "fieldline.cabal" + [fieldLineDocumentSymbol], + testSymbols + "cabal Section outline test" + "section.cabal" + [sectionDocumentSymbol], + testSymbols + "cabal SectionArg outline test" + "sectionarg.cabal" + [sectionArgDocumentSymbol] + ] + where + fieldDocumentSymbol = (Outline.defDocumentSymbol (LSP.Range {_start = LSP.Position {_line = 0, _character = 0}, + _end = LSP.Position {_line = 0, _character = 8}})) + { LSP._name = "homepage", + LSP._kind = LSP.SymbolKind_Field, + LSP._children = Nothing + } + fieldLineDocumentSymbol = (Outline.defDocumentSymbol (LSP.Range {_start = LSP.Position {_line = 0, _character = 0}, + _end = LSP.Position {_line = 0, _character = 13}})) + { LSP._name = "cabal-version", + LSP._kind = LSP.SymbolKind_Field, + LSP._children = Nothing -- the values of fieldLine are removed from the outline + } + sectionDocumentSymbol = (Outline.defDocumentSymbol (LSP.Range {_start = LSP.Position {_line = 0, _character = 2}, + _end = LSP.Position {_line = 0, _character = 15}})) + { LSP._name = "build-depends", + LSP._kind = LSP.SymbolKind_Field, + LSP._children = Nothing -- the values of fieldLine are removed from the outline + } + sectionArgDocumentSymbol = (Outline.defDocumentSymbol (LSP.Range {_start = LSP.Position {_line = 0, _character = 2}, + _end = LSP.Position {_line = 0, _character = 19}})) + { LSP._name = "if os ( windows )", + LSP._kind = LSP.SymbolKind_Object, + LSP._children = Just $ [sectionArgChildrenDocumentSymbol] } + sectionArgChildrenDocumentSymbol = (Outline.defDocumentSymbol (LSP.Range {_start = LSP.Position {_line = 1, _character = 4}, + _end = LSP.Position {_line = 1, _character = 17}})) + { LSP._name = "build-depends", + LSP._kind = LSP.SymbolKind_Field, + LSP._children = Nothing + } diff --git a/plugins/hls-cabal-plugin/test/testdata/outline-cabal/field.cabal b/plugins/hls-cabal-plugin/test/testdata/outline-cabal/field.cabal new file mode 100644 index 0000000000..c3e3d80df2 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/outline-cabal/field.cabal @@ -0,0 +1 @@ +homepage: \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/testdata/outline-cabal/fieldline.cabal b/plugins/hls-cabal-plugin/test/testdata/outline-cabal/fieldline.cabal new file mode 100644 index 0000000000..998369e5f1 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/outline-cabal/fieldline.cabal @@ -0,0 +1 @@ +cabal-version: 3.0 diff --git a/plugins/hls-cabal-plugin/test/testdata/outline-cabal/section.cabal b/plugins/hls-cabal-plugin/test/testdata/outline-cabal/section.cabal new file mode 100644 index 0000000000..8a140c7517 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/outline-cabal/section.cabal @@ -0,0 +1,2 @@ + build-depends: + base >=4.16 && <5 \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/testdata/outline-cabal/sectionarg.cabal b/plugins/hls-cabal-plugin/test/testdata/outline-cabal/sectionarg.cabal new file mode 100644 index 0000000000..060d067377 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/outline-cabal/sectionarg.cabal @@ -0,0 +1,2 @@ + if os(windows) + build-depends: Win32 \ No newline at end of file From d201493d07fc2e3b0a66fe5f4efb7fe6f3c6b245 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 1 Jul 2024 19:21:52 +0300 Subject: [PATCH 09/22] imports changes --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs index 8b2f43c9f2..fc3d449254 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -25,10 +25,12 @@ import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), cabalPositionToLSPPosition) import Ide.Plugin.Cabal.Orphans () import Ide.Types (PluginMethodHandler) -import qualified Language.LSP.Protocol.Message as LSP +import Language.LSP.Protocol.Message (Method (..)) import qualified Language.LSP.Protocol.Types as LSP +import Language.LSP.Protocol.Types (DocumentSymbol (..)) -moduleOutline :: PluginMethodHandler IdeState LSP.Method_TextDocumentDocumentSymbol + +moduleOutline :: PluginMethodHandler IdeState Method_TextDocumentDocumentSymbol moduleOutline ideState _ LSP.DocumentSymbolParams {_textDocument = LSP.TextDocumentIdentifier uri} = case LSP.uriToFilePath uri of Just (toNormalizedFilePath' -> fp) -> do @@ -43,7 +45,7 @@ moduleOutline ideState _ LSP.DocumentSymbolParams {_textDocument = LSP.TextDocum -- | Creates a DocumentSumbol object for the -- cabal AST, without displaying fieldLines and -- displaying Section name and SectionArgs in one line -documentSymbolForField :: Field Position -> Maybe LSP.DocumentSymbol +documentSymbolForField :: Field Position -> Maybe DocumentSymbol documentSymbolForField (Field (Name pos fieldName) _) = Just (defDocumentSymbol range) @@ -89,8 +91,8 @@ addNameLengthToLSPRange (LSP.Range pos1 (LSP.Position line char)) name = pos1 (LSP.Position line (char + fromIntegral (T.length name))) -defDocumentSymbol :: LSP.Range -> LSP.DocumentSymbol -defDocumentSymbol range = LSP.DocumentSymbol {..} +defDocumentSymbol :: LSP.Range -> DocumentSymbol +defDocumentSymbol range = DocumentSymbol {..} where _detail = Nothing _deprecated = Nothing From f4d57a525c1cd88a075ad69d23e0a76b9ead0f56 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 1 Jul 2024 19:26:52 +0300 Subject: [PATCH 10/22] outline tests changes --- .../src/Ide/Plugin/Cabal/Outline.hs | 35 ++++++----- plugins/hls-cabal-plugin/test/Outline.hs | 58 ++++++++++--------- .../schema/ghc98/default-config.golden.json | 3 +- .../ghc98/vscode-extension-schema.golden.json | 6 ++ 4 files changed, 56 insertions(+), 46 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs index fc3d449254..a272b5e2e1 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -3,7 +3,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Cabal.Outline where @@ -26,8 +25,8 @@ import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), import Ide.Plugin.Cabal.Orphans () import Ide.Types (PluginMethodHandler) import Language.LSP.Protocol.Message (Method (..)) -import qualified Language.LSP.Protocol.Types as LSP import Language.LSP.Protocol.Types (DocumentSymbol (..)) +import qualified Language.LSP.Protocol.Types as LSP moduleOutline :: PluginMethodHandler IdeState Method_TextDocumentDocumentSymbol @@ -49,18 +48,18 @@ documentSymbolForField :: Field Position -> Maybe DocumentSymbol documentSymbolForField (Field (Name pos fieldName) _) = Just (defDocumentSymbol range) - { LSP._name = decodeUtf8 fieldName, - LSP._kind = LSP.SymbolKind_Field, - LSP._children = Nothing + { _name = decodeUtf8 fieldName, + _kind = LSP.SymbolKind_Field, + _children = Nothing } where range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 fieldName documentSymbolForField (Section (Name pos fieldName) sectionArgs fields) = Just (defDocumentSymbol range) - { LSP._name = joinedName, - LSP._kind = LSP.SymbolKind_Object, - LSP._children = + { _name = joinedName, + _kind = LSP.SymbolKind_Object, + _children = Just (mapMaybe documentSymbolForField fields) } @@ -92,13 +91,13 @@ addNameLengthToLSPRange (LSP.Range pos1 (LSP.Position line char)) name = (LSP.Position line (char + fromIntegral (T.length name))) defDocumentSymbol :: LSP.Range -> DocumentSymbol -defDocumentSymbol range = DocumentSymbol {..} - where - _detail = Nothing - _deprecated = Nothing - _name = "" - _kind = LSP.SymbolKind_File - _range = range - _selectionRange = range - _children = Nothing - _tags = Nothing +defDocumentSymbol range = DocumentSymbol + { _detail = Nothing + , _deprecated = Nothing + , _name = "" + , _kind = LSP.SymbolKind_File + , _range = range + , _selectionRange = range + , _children = Nothing + , _tags = Nothing + } diff --git a/plugins/hls-cabal-plugin/test/Outline.hs b/plugins/hls-cabal-plugin/test/Outline.hs index 0e9e8582a5..e0c52930e1 100644 --- a/plugins/hls-cabal-plugin/test/Outline.hs +++ b/plugins/hls-cabal-plugin/test/Outline.hs @@ -5,8 +5,7 @@ module Outline ( outlineTests ) where -import qualified Ide.Plugin.Cabal.Outline as Outline -import qualified Language.LSP.Protocol.Types as LSP +import Ide.Plugin.Cabal.Outline (defDocumentSymbol) import Test.Hls import Utils @@ -39,32 +38,37 @@ outlineTests = [sectionArgDocumentSymbol] ] where - fieldDocumentSymbol = (Outline.defDocumentSymbol (LSP.Range {_start = LSP.Position {_line = 0, _character = 0}, - _end = LSP.Position {_line = 0, _character = 8}})) - { LSP._name = "homepage", - LSP._kind = LSP.SymbolKind_Field, - LSP._children = Nothing + fieldDocumentSymbol :: DocumentSymbol + fieldDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 0, _character = 0}, + _end = Position {_line = 0, _character = 8}})) + { _name = "homepage", + _kind = SymbolKind_Field, + _children = Nothing } - fieldLineDocumentSymbol = (Outline.defDocumentSymbol (LSP.Range {_start = LSP.Position {_line = 0, _character = 0}, - _end = LSP.Position {_line = 0, _character = 13}})) - { LSP._name = "cabal-version", - LSP._kind = LSP.SymbolKind_Field, - LSP._children = Nothing -- the values of fieldLine are removed from the outline + fieldLineDocumentSymbol :: DocumentSymbol + fieldLineDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 0, _character = 0}, + _end = Position {_line = 0, _character = 13}})) + { _name = "cabal-version", + _kind = SymbolKind_Field, + _children = Nothing -- the values of fieldLine are removed from the outline } - sectionDocumentSymbol = (Outline.defDocumentSymbol (LSP.Range {_start = LSP.Position {_line = 0, _character = 2}, - _end = LSP.Position {_line = 0, _character = 15}})) - { LSP._name = "build-depends", - LSP._kind = LSP.SymbolKind_Field, - LSP._children = Nothing -- the values of fieldLine are removed from the outline + sectionDocumentSymbol :: DocumentSymbol + sectionDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 0, _character = 2}, + _end = Position {_line = 0, _character = 15}})) + { _name = "build-depends", + _kind = SymbolKind_Field, + _children = Nothing -- the values of fieldLine are removed from the outline } - sectionArgDocumentSymbol = (Outline.defDocumentSymbol (LSP.Range {_start = LSP.Position {_line = 0, _character = 2}, - _end = LSP.Position {_line = 0, _character = 19}})) - { LSP._name = "if os ( windows )", - LSP._kind = LSP.SymbolKind_Object, - LSP._children = Just $ [sectionArgChildrenDocumentSymbol] } - sectionArgChildrenDocumentSymbol = (Outline.defDocumentSymbol (LSP.Range {_start = LSP.Position {_line = 1, _character = 4}, - _end = LSP.Position {_line = 1, _character = 17}})) - { LSP._name = "build-depends", - LSP._kind = LSP.SymbolKind_Field, - LSP._children = Nothing + sectionArgDocumentSymbol :: DocumentSymbol + sectionArgDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 0, _character = 2}, + _end = Position {_line = 0, _character = 19}})) + { _name = "if os ( windows )", + _kind = SymbolKind_Object, + _children = Just $ [sectionArgChildrenDocumentSymbol] } + sectionArgChildrenDocumentSymbol :: DocumentSymbol + sectionArgChildrenDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 1, _character = 4}, + _end = Position {_line = 1, _character = 17}})) + { _name = "build-depends", + _kind = SymbolKind_Field, + _children = Nothing } diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json index 2859e3d720..9b51765ec8 100644 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -11,7 +11,8 @@ "cabal": { "codeActionsOn": true, "completionOn": true, - "diagnosticsOn": true + "diagnosticsOn": true, + "symbolsOn": true }, "cabal-fmt": { "config": { diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json index d113264901..6dd980b2be 100644 --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -35,6 +35,12 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.cabal.symbolsOn": { + "default": true, + "description": "Enables cabal symbols", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.callHierarchy.globalOn": { "default": true, "description": "Enables callHierarchy plugin", From 526fac3e6c7c43d804099c969a61dd9fc6a2c6ae Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 2 Jul 2024 06:19:00 +0300 Subject: [PATCH 11/22] duplicate defDocumentSymbol --- plugins/hls-cabal-plugin/test/Outline.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/test/Outline.hs b/plugins/hls-cabal-plugin/test/Outline.hs index e0c52930e1..39584bb1f7 100644 --- a/plugins/hls-cabal-plugin/test/Outline.hs +++ b/plugins/hls-cabal-plugin/test/Outline.hs @@ -5,7 +5,7 @@ module Outline ( outlineTests ) where -import Ide.Plugin.Cabal.Outline (defDocumentSymbol) +import qualified Language.LSP.Protocol.Types as LSP import Test.Hls import Utils @@ -72,3 +72,15 @@ outlineTests = _kind = SymbolKind_Field, _children = Nothing } + +defDocumentSymbol :: LSP.Range -> DocumentSymbol +defDocumentSymbol range = DocumentSymbol + { _detail = Nothing + , _deprecated = Nothing + , _name = "" + , _kind = LSP.SymbolKind_File + , _range = range + , _selectionRange = range + , _children = Nothing + , _tags = Nothing + } From 9860ea3a71a85de4a355eca5192f69c66bd133d9 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 2 Jul 2024 07:15:43 +0300 Subject: [PATCH 12/22] cabal outline test imports change --- plugins/hls-cabal-plugin/test/Outline.hs | 34 ++++++++++++------------ 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/plugins/hls-cabal-plugin/test/Outline.hs b/plugins/hls-cabal-plugin/test/Outline.hs index 39584bb1f7..b0e8947889 100644 --- a/plugins/hls-cabal-plugin/test/Outline.hs +++ b/plugins/hls-cabal-plugin/test/Outline.hs @@ -1,24 +1,24 @@ -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module Outline ( outlineTests ) where -import qualified Language.LSP.Protocol.Types as LSP -import Test.Hls +import Language.LSP.Protocol.Types (DocumentSymbol (..), + Position (..), Range (..)) +import qualified Test.Hls as T import Utils -testSymbols :: (HasCallStack) => TestName -> FilePath -> [DocumentSymbol] -> TestTree +testSymbols :: (T.HasCallStack) => T.TestName -> FilePath -> [DocumentSymbol] -> T.TestTree testSymbols testName path expectedSymbols = runCabalTestCaseSession testName "outline-cabal" $ do - docId <- openDoc path "cabal" - symbols <- getDocumentSymbols docId - liftIO $ symbols @?= Right expectedSymbols + docId <- T.openDoc path "cabal" + symbols <- T.getDocumentSymbols docId + T.liftIO $ symbols T.@?= Right expectedSymbols -outlineTests :: TestTree +outlineTests :: T.TestTree outlineTests = - testGroup + T.testGroup "Cabal Outline Tests" [ testSymbols "cabal Field outline test" @@ -42,43 +42,43 @@ outlineTests = fieldDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 0, _character = 0}, _end = Position {_line = 0, _character = 8}})) { _name = "homepage", - _kind = SymbolKind_Field, + _kind = T.SymbolKind_Field, _children = Nothing } fieldLineDocumentSymbol :: DocumentSymbol fieldLineDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 0, _character = 0}, _end = Position {_line = 0, _character = 13}})) { _name = "cabal-version", - _kind = SymbolKind_Field, + _kind = T.SymbolKind_Field, _children = Nothing -- the values of fieldLine are removed from the outline } sectionDocumentSymbol :: DocumentSymbol sectionDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 0, _character = 2}, _end = Position {_line = 0, _character = 15}})) { _name = "build-depends", - _kind = SymbolKind_Field, + _kind = T.SymbolKind_Field, _children = Nothing -- the values of fieldLine are removed from the outline } sectionArgDocumentSymbol :: DocumentSymbol sectionArgDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 0, _character = 2}, _end = Position {_line = 0, _character = 19}})) { _name = "if os ( windows )", - _kind = SymbolKind_Object, + _kind = T.SymbolKind_Object, _children = Just $ [sectionArgChildrenDocumentSymbol] } sectionArgChildrenDocumentSymbol :: DocumentSymbol sectionArgChildrenDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 1, _character = 4}, _end = Position {_line = 1, _character = 17}})) { _name = "build-depends", - _kind = SymbolKind_Field, + _kind = T.SymbolKind_Field, _children = Nothing } -defDocumentSymbol :: LSP.Range -> DocumentSymbol +defDocumentSymbol :: Range -> DocumentSymbol defDocumentSymbol range = DocumentSymbol { _detail = Nothing , _deprecated = Nothing , _name = "" - , _kind = LSP.SymbolKind_File + , _kind = T.SymbolKind_File , _range = range , _selectionRange = range , _children = Nothing From a79be35b933c96f976b3090e4d77b1d4cf551547 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 2 Jul 2024 07:47:51 +0300 Subject: [PATCH 13/22] schema 96 94 update --- test/testdata/schema/ghc94/default-config.golden.json | 3 ++- .../schema/ghc94/vscode-extension-schema.golden.json | 6 ++++++ test/testdata/schema/ghc96/default-config.golden.json | 3 ++- .../schema/ghc96/vscode-extension-schema.golden.json | 6 ++++++ 4 files changed, 16 insertions(+), 2 deletions(-) diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json index 2859e3d720..9b51765ec8 100644 --- a/test/testdata/schema/ghc94/default-config.golden.json +++ b/test/testdata/schema/ghc94/default-config.golden.json @@ -11,7 +11,8 @@ "cabal": { "codeActionsOn": true, "completionOn": true, - "diagnosticsOn": true + "diagnosticsOn": true, + "symbolsOn": true }, "cabal-fmt": { "config": { diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json index d113264901..c8f595756f 100644 --- a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json @@ -17,6 +17,12 @@ "scope": "resource", "type": "string" }, + "haskell.plugin.cabal.symbolsOn": { + "default": true, + "description": "Enables cabal symbols", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.cabal.codeActionsOn": { "default": true, "description": "Enables cabal code actions", diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json index 2859e3d720..9b51765ec8 100644 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -11,7 +11,8 @@ "cabal": { "codeActionsOn": true, "completionOn": true, - "diagnosticsOn": true + "diagnosticsOn": true, + "symbolsOn": true }, "cabal-fmt": { "config": { diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json index d113264901..6dd980b2be 100644 --- a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json @@ -35,6 +35,12 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.cabal.symbolsOn": { + "default": true, + "description": "Enables cabal symbols", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.callHierarchy.globalOn": { "default": true, "description": "Enables callHierarchy plugin", From a0642ef7063d379a38793dda87b94a12b31f983a Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Tue, 2 Jul 2024 08:19:52 +0300 Subject: [PATCH 14/22] schema 94 update --- .../schema/ghc94/vscode-extension-schema.golden.json | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json index c8f595756f..d3e6e3bc5f 100644 --- a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json @@ -17,15 +17,15 @@ "scope": "resource", "type": "string" }, - "haskell.plugin.cabal.symbolsOn": { + "haskell.plugin.cabal.codeActionsOn": { "default": true, - "description": "Enables cabal symbols", + "description": "Enables cabal code actions", "scope": "resource", "type": "boolean" - }, - "haskell.plugin.cabal.codeActionsOn": { + }, + "haskell.plugin.cabal.symbolsOn": { "default": true, - "description": "Enables cabal code actions", + "description": "Enables cabal symbols", "scope": "resource", "type": "boolean" }, From c867a29cf203f913c67d64e31b1cb40c0802974b Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 10 Jul 2024 10:36:25 +0300 Subject: [PATCH 15/22] 94 schema update --- .../schema/ghc94/vscode-extension-schema.golden.json | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json index d3e6e3bc5f..fe7dd16929 100644 --- a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json @@ -22,16 +22,16 @@ "description": "Enables cabal code actions", "scope": "resource", "type": "boolean" - }, - "haskell.plugin.cabal.symbolsOn": { + }, + "haskell.plugin.cabal.completionOn": { "default": true, - "description": "Enables cabal symbols", + "description": "Enables cabal completions", "scope": "resource", "type": "boolean" }, - "haskell.plugin.cabal.completionOn": { + "haskell.plugin.cabal.symbolsOn": { "default": true, - "description": "Enables cabal completions", + "description": "Enables cabal symbols", "scope": "resource", "type": "boolean" }, From aeca984a8a0cf845c9db265a85e22b81ced94b2b Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Wed, 10 Jul 2024 11:09:42 +0300 Subject: [PATCH 16/22] 94 schema update --- .../schema/ghc94/vscode-extension-schema.golden.json | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json index fe7dd16929..6dd980b2be 100644 --- a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json @@ -29,15 +29,15 @@ "scope": "resource", "type": "boolean" }, - "haskell.plugin.cabal.symbolsOn": { + "haskell.plugin.cabal.diagnosticsOn": { "default": true, - "description": "Enables cabal symbols", + "description": "Enables cabal diagnostics", "scope": "resource", "type": "boolean" }, - "haskell.plugin.cabal.diagnosticsOn": { + "haskell.plugin.cabal.symbolsOn": { "default": true, - "description": "Enables cabal diagnostics", + "description": "Enables cabal symbols", "scope": "resource", "type": "boolean" }, From f77dea526d66d353784527e5e7106984ce150ecd Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Thu, 11 Jul 2024 14:47:30 +0300 Subject: [PATCH 17/22] + cabal-add --- cabal-add | 1 + 1 file changed, 1 insertion(+) create mode 160000 cabal-add diff --git a/cabal-add b/cabal-add new file mode 160000 index 0000000000..6e48220530 --- /dev/null +++ b/cabal-add @@ -0,0 +1 @@ +Subproject commit 6e482205307cb6fd3713338c6467506eabfb8761 From 6f9fbcd26d8e514e0bdd67564fee9bcb3dcbc633 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Thu, 11 Jul 2024 14:53:25 +0300 Subject: [PATCH 18/22] Revert "+ cabal-add" This reverts commit f77dea526d66d353784527e5e7106984ce150ecd. --- cabal-add | 1 - 1 file changed, 1 deletion(-) delete mode 160000 cabal-add diff --git a/cabal-add b/cabal-add deleted file mode 160000 index 6e48220530..0000000000 --- a/cabal-add +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 6e482205307cb6fd3713338c6467506eabfb8761 From 4735e7dfd74bdb1be11eedf3cc6bbe84dadf8e61 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Thu, 11 Jul 2024 16:53:16 +0300 Subject: [PATCH 19/22] + docs, refactoring --- .../Plugin/Cabal/Completion/CabalFields.hs | 18 ++- .../src/Ide/Plugin/Cabal/Completion/Types.hs | 4 + .../src/Ide/Plugin/Cabal/Outline.hs | 78 +++++++---- plugins/hls-cabal-plugin/test/Outline.hs | 132 ++++++++++-------- 4 files changed, 144 insertions(+), 88 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index 02daa72826..c78088f63d 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -1,4 +1,4 @@ -module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, getOptionalSectionName, getAnnotation, getFieldName) where +module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, getOptionalSectionName, getAnnotation, getFieldName, onelineSectionArgs) where import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE @@ -66,3 +66,19 @@ getOptionalSectionName (x:xs) = case x of Syntax.SecArgName _ name -> Just (T.decodeUtf8 name) _ -> getOptionalSectionName xs + +-- | Makes a single text line out of multiple +-- @SectionArg@s. Allowes to display conditions, +-- flags, etc in one line, which is easier to read. +-- +-- For example, @flag@ @(@ @pedantic@ @)@ will be joined in +-- one line, instead of four @SectionArg@s separately. +onelineSectionArgs :: [Syntax.SectionArg Syntax.Position] -> T.Text +onelineSectionArgs sectionArgs = joinedName + where + joinedName = T.unwords $ map getName sectionArgs + + getName :: Syntax.SectionArg Syntax.Position -> T.Text + getName (Syntax.SecArgName _ identifier) = T.decodeUtf8 identifier + getName (Syntax.SecArgStr _ quotedString) = T.decodeUtf8 quotedString + getName (Syntax.SecArgOther _ string) = T.decodeUtf8 string \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs index 4ba8ee5260..2655fbcaa6 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs @@ -181,5 +181,9 @@ lspPositionToCabalPosition pos = Syntax.Position (fromIntegral (pos ^. JL.line) + 1) (fromIntegral (pos ^. JL.character) + 1) +-- | Convert an 'Syntax.Position' to a LSP 'Position'. +-- +-- Cabal Positions start their indexing at 1 while LSP starts at 0. +-- This helper makes sure, the translation is done properly. cabalPositionToLSPPosition :: Syntax.Position -> Position cabalPositionToLSPPosition (Syntax.Position start end) = Position (toEnum start -1) (toEnum end -1) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs index a272b5e2e1..40f348f88c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -9,24 +9,24 @@ module Ide.Plugin.Cabal.Outline where import Control.Monad.IO.Class import Data.Maybe -import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8) +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8) import Development.IDE.Core.Rules -import Development.IDE.Core.Shake (IdeState (shakeExtras), - runIdeAction, - useWithStaleFast) -import Development.IDE.Types.Location (toNormalizedFilePath') -import Distribution.Fields.Field (Field (Field, Section), - Name (Name), - SectionArg (SecArgName, SecArgOther, SecArgStr)) -import Distribution.Parsec.Position (Position) -import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), - cabalPositionToLSPPosition) -import Ide.Plugin.Cabal.Orphans () -import Ide.Types (PluginMethodHandler) -import Language.LSP.Protocol.Message (Method (..)) -import Language.LSP.Protocol.Types (DocumentSymbol (..)) -import qualified Language.LSP.Protocol.Types as LSP +import Development.IDE.Core.Shake (IdeState (shakeExtras), + runIdeAction, + useWithStaleFast) +import Development.IDE.Types.Location (toNormalizedFilePath') +import Distribution.Fields.Field (Field (Field, Section), + Name (Name)) +import Distribution.Parsec.Position (Position) +import Ide.Plugin.Cabal.Completion.CabalFields (onelineSectionArgs) +import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), + cabalPositionToLSPPosition) +import Ide.Plugin.Cabal.Orphans () +import Ide.Types (PluginMethodHandler) +import Language.LSP.Protocol.Message (Method (..)) +import Language.LSP.Protocol.Types (DocumentSymbol (..)) +import qualified Language.LSP.Protocol.Types as LSP moduleOutline :: PluginMethodHandler IdeState Method_TextDocumentDocumentSymbol @@ -41,9 +41,35 @@ moduleOutline ideState _ LSP.DocumentSymbolParams {_textDocument = LSP.TextDocum Nothing -> pure $ LSP.InL [] Nothing -> pure $ LSP.InL [] --- | Creates a DocumentSumbol object for the --- cabal AST, without displaying fieldLines and --- displaying Section name and SectionArgs in one line +-- | Creates a @DocumentSymbol@ object for the +-- cabal AST, without displaying @fieldLines@ and +-- displaying @Section Name@ and @SectionArgs@ in one line. +-- +-- @fieldLines@ are leaves of a cabal AST, so they are omitted +-- in the outline. Sections have to be displayed in one line, because +-- the AST representation looks unnatural. See examples: +-- +-- * part of a cabal file: +-- +-- > if impl(ghc >= 9.8) +-- > ghc-options: -Wall +-- +-- * AST representation: +-- +-- > if +-- > impl +-- > ( +-- > ghc >= 9.8 +-- > ) +-- > +-- > ghc-options: +-- > -Wall +-- +-- * resulting @DocumentSymbol@: +-- +-- > if impl(ghc >= 9.8) +-- > ghc-options: +-- > documentSymbolForField :: Field Position -> Maybe DocumentSymbol documentSymbolForField (Field (Name pos fieldName) _) = Just @@ -64,19 +90,9 @@ documentSymbolForField (Section (Name pos fieldName) sectionArgs fields) = (mapMaybe documentSymbolForField fields) } where - joinedName = decodeUtf8 fieldName <> " " <> joinedNameForSectionArgs sectionArgs + joinedName = decodeUtf8 fieldName <> " " <> onelineSectionArgs sectionArgs range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` joinedName -joinedNameForSectionArgs :: [SectionArg Position] -> T.Text -joinedNameForSectionArgs sectionArgs = joinedName - where - joinedName = T.unwords $ map getName sectionArgs - - getName :: SectionArg Position -> T.Text - getName (SecArgName _ identifier) = decodeUtf8 identifier - getName (SecArgStr _ quotedString) = decodeUtf8 quotedString - getName (SecArgOther _ string) = decodeUtf8 string - -- | Creates a single point LSP range -- using cabal position cabalPositionToLSPRange :: Position -> LSP.Range diff --git a/plugins/hls-cabal-plugin/test/Outline.hs b/plugins/hls-cabal-plugin/test/Outline.hs index b0e8947889..54de33290d 100644 --- a/plugins/hls-cabal-plugin/test/Outline.hs +++ b/plugins/hls-cabal-plugin/test/Outline.hs @@ -1,13 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} module Outline ( - outlineTests + outlineTests, ) where -import Language.LSP.Protocol.Types (DocumentSymbol (..), - Position (..), Range (..)) -import qualified Test.Hls as T -import Utils +import Language.LSP.Protocol.Types ( + DocumentSymbol (..), + Position (..), + Range (..), + ) +import Test.Hls qualified as T +import Utils testSymbols :: (T.HasCallStack) => T.TestName -> FilePath -> [DocumentSymbol] -> T.TestTree testSymbols testName path expectedSymbols = @@ -23,64 +26,81 @@ outlineTests = [ testSymbols "cabal Field outline test" "field.cabal" - [fieldDocumentSymbol], - testSymbols + [fieldDocumentSymbol] + , testSymbols "cabal FieldLine outline test" "fieldline.cabal" - [fieldLineDocumentSymbol], - testSymbols + [fieldLineDocumentSymbol] + , testSymbols "cabal Section outline test" "section.cabal" - [sectionDocumentSymbol], - testSymbols + [sectionDocumentSymbol] + , testSymbols "cabal SectionArg outline test" "sectionarg.cabal" [sectionArgDocumentSymbol] ] - where - fieldDocumentSymbol :: DocumentSymbol - fieldDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 0, _character = 0}, - _end = Position {_line = 0, _character = 8}})) - { _name = "homepage", - _kind = T.SymbolKind_Field, - _children = Nothing - } - fieldLineDocumentSymbol :: DocumentSymbol - fieldLineDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 0, _character = 0}, - _end = Position {_line = 0, _character = 13}})) - { _name = "cabal-version", - _kind = T.SymbolKind_Field, - _children = Nothing -- the values of fieldLine are removed from the outline - } - sectionDocumentSymbol :: DocumentSymbol - sectionDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 0, _character = 2}, - _end = Position {_line = 0, _character = 15}})) - { _name = "build-depends", - _kind = T.SymbolKind_Field, - _children = Nothing -- the values of fieldLine are removed from the outline - } - sectionArgDocumentSymbol :: DocumentSymbol - sectionArgDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 0, _character = 2}, - _end = Position {_line = 0, _character = 19}})) - { _name = "if os ( windows )", - _kind = T.SymbolKind_Object, - _children = Just $ [sectionArgChildrenDocumentSymbol] } - sectionArgChildrenDocumentSymbol :: DocumentSymbol - sectionArgChildrenDocumentSymbol = (defDocumentSymbol (Range {_start = Position {_line = 1, _character = 4}, - _end = Position {_line = 1, _character = 17}})) - { _name = "build-depends", - _kind = T.SymbolKind_Field, - _children = Nothing - } + where + fieldDocumentSymbol :: DocumentSymbol + fieldDocumentSymbol = + ( defDocumentSymbol + ( Range { _start = Position{_line = 0, _character = 0} + , _end = Position{_line = 0, _character = 8} }) + ) + { _name = "homepage" + , _kind = T.SymbolKind_Field + , _children = Nothing + } + fieldLineDocumentSymbol :: DocumentSymbol + fieldLineDocumentSymbol = + ( defDocumentSymbol + ( Range { _start = Position{_line = 0, _character = 0} + , _end = Position{_line = 0, _character = 13} }) + ) + { _name = "cabal-version" + , _kind = T.SymbolKind_Field + , _children = Nothing -- the values of fieldLine are removed from the outline + } + sectionDocumentSymbol :: DocumentSymbol + sectionDocumentSymbol = + ( defDocumentSymbol + ( Range { _start = Position{_line = 0, _character = 2} + , _end = Position{_line = 0, _character = 15} }) + ) + { _name = "build-depends" + , _kind = T.SymbolKind_Field + , _children = Nothing -- the values of fieldLine are removed from the outline + } + sectionArgDocumentSymbol :: DocumentSymbol + sectionArgDocumentSymbol = + ( defDocumentSymbol + ( Range { _start = Position{_line = 0, _character = 2} + , _end = Position{_line = 0, _character = 19} }) + ) + { _name = "if os ( windows )" + , _kind = T.SymbolKind_Object + , _children = Just $ [sectionArgChildrenDocumentSymbol] + } + sectionArgChildrenDocumentSymbol :: DocumentSymbol + sectionArgChildrenDocumentSymbol = + ( defDocumentSymbol + ( Range { _start = Position{_line = 1, _character = 4} + , _end = Position{_line = 1, _character = 17} }) + ) + { _name = "build-depends" + , _kind = T.SymbolKind_Field + , _children = Nothing + } defDocumentSymbol :: Range -> DocumentSymbol -defDocumentSymbol range = DocumentSymbol - { _detail = Nothing - , _deprecated = Nothing - , _name = "" - , _kind = T.SymbolKind_File - , _range = range - , _selectionRange = range - , _children = Nothing - , _tags = Nothing - } +defDocumentSymbol range = + DocumentSymbol + { _detail = Nothing + , _deprecated = Nothing + , _name = "" + , _kind = T.SymbolKind_File + , _range = range + , _selectionRange = range + , _children = Nothing + , _tags = Nothing + } From 000dcbe5e4d42905ad32babaa5c5a3db0bbe02c2 Mon Sep 17 00:00:00 2001 From: fendor Date: Thu, 11 Jul 2024 18:10:49 +0200 Subject: [PATCH 20/22] Update plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs --- .../src/Ide/Plugin/Cabal/Completion/CabalFields.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index c78088f63d..653ef69fb8 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -68,7 +68,7 @@ getOptionalSectionName (x:xs) = case x of -- | Makes a single text line out of multiple --- @SectionArg@s. Allowes to display conditions, +-- @SectionArg@s. Allows to display conditions, -- flags, etc in one line, which is easier to read. -- -- For example, @flag@ @(@ @pedantic@ @)@ will be joined in From cb2fbf7d31e8872c5b2cab48e09119f1bd6b0fa0 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 15 Jul 2024 19:19:56 +0300 Subject: [PATCH 21/22] formatting --- .../src/Ide/Plugin/Cabal/Completion/CabalFields.hs | 2 +- .../hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs | 2 +- plugins/hls-cabal-plugin/test/Outline.hs | 11 ++++------- 3 files changed, 6 insertions(+), 9 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs index 653ef69fb8..84ec3ec345 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -81,4 +81,4 @@ onelineSectionArgs sectionArgs = joinedName getName :: Syntax.SectionArg Syntax.Position -> T.Text getName (Syntax.SecArgName _ identifier) = T.decodeUtf8 identifier getName (Syntax.SecArgStr _ quotedString) = T.decodeUtf8 quotedString - getName (Syntax.SecArgOther _ string) = T.decodeUtf8 string \ No newline at end of file + getName (Syntax.SecArgOther _ string) = T.decodeUtf8 string diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs index 40f348f88c..f230bfca1e 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -116,4 +116,4 @@ defDocumentSymbol range = DocumentSymbol , _selectionRange = range , _children = Nothing , _tags = Nothing - } + } \ No newline at end of file diff --git a/plugins/hls-cabal-plugin/test/Outline.hs b/plugins/hls-cabal-plugin/test/Outline.hs index 54de33290d..cb7279e387 100644 --- a/plugins/hls-cabal-plugin/test/Outline.hs +++ b/plugins/hls-cabal-plugin/test/Outline.hs @@ -4,13 +4,10 @@ module Outline ( outlineTests, ) where -import Language.LSP.Protocol.Types ( - DocumentSymbol (..), - Position (..), - Range (..), - ) -import Test.Hls qualified as T -import Utils +import Language.LSP.Protocol.Types (DocumentSymbol (..), + Position (..), Range (..)) +import qualified Test.Hls as T +import Utils testSymbols :: (T.HasCallStack) => T.TestName -> FilePath -> [DocumentSymbol] -> T.TestTree testSymbols testName path expectedSymbols = From 050af38e30243875cf959e7dd92424218df5bb92 Mon Sep 17 00:00:00 2001 From: George Gerasev Date: Mon, 15 Jul 2024 19:31:47 +0300 Subject: [PATCH 22/22] newline --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs index f230bfca1e..40f348f88c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs @@ -116,4 +116,4 @@ defDocumentSymbol range = DocumentSymbol , _selectionRange = range , _children = Nothing , _tags = Nothing - } \ No newline at end of file + }