haskell/haskell-language-server
1
1
Fork 0
mirror of https://github.com/haskell/haskell-language-server.git synced 2024-09-11 08:45:35 +03:00
Code Issues Projects Releases Wiki Activity

Cabal plugin outline view (#4323)

Browse Source 
* working test message cabal file

* trivial outline with rule invocation

* outline with field lines

* complete outline prototype

* small improvements

* remove fieldLines, one line Section display

* stylish haskell

* tests

* imports changes

* outline tests changes

* duplicate defDocumentSymbol

* cabal outline test imports change

* schema 96 94 update

* schema 94 update

* 94 schema update

* 94 schema update

* + cabal-add

* Revert "+ cabal-add"

This reverts commit f77dea526d.

* + docs, refactoring

* Update plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs

* formatting

* newline

---------

Co-authored-by: fendor <fendor@users.noreply.github.com>
This commit is contained in:
Georgii Gerasev 2024-07-30 16:14:58 +03:00 committed by GitHub
parent a4bcaa318e
commit 0bf3348f0d
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
17 changed files with 282 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
haskell-language-server.cabal
View File

@ -245,6 +245,7 @@ library hls-cabal-plugin
Ide.Plugin.Cabal.FieldSuggest
Ide.Plugin.Cabal.LicenseSuggest
Ide.Plugin.Cabal.Orphans
Ide.Plugin.Cabal.Outline
Ide.Plugin.Cabal.Parse
@ -282,6 +283,7 @@ test-suite hls-cabal-plugin-tests
Completer
Context
Utils
Outline
build-depends:
, base
, bytestring

2
plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
View File

@ -41,6 +41,7 @@ import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
import Ide.Plugin.Cabal.Orphans ()
import Ide.Plugin.Cabal.Outline
import qualified Ide.Plugin.Cabal.Parse as Parse
import Ide.Types
import qualified Language.LSP.Protocol.Lens as JL
@ -90,6 +91,7 @@ descriptor recorder plId =
mconcat
[ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction
, mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder
, mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline
, mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
]
, pluginNotificationHandlers =

18
plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs
View File

@ -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. Allows 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

7
plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs
View File

@ -180,3 +180,10 @@ lspPositionToCabalPosition :: Position -> Syntax.Position
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)

119
plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs Normal file
View File

@ -0,0 +1,119 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
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 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))
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
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)
case fmap fst mFields of
Just fieldPositions -> pure $ LSP.InR (LSP.InL allSymbols)
where
allSymbols = mapMaybe documentSymbolForField fieldPositions
Nothing -> pure $ LSP.InL []
Nothing -> pure $ LSP.InL []
-- | 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
(defDocumentSymbol range)
{ _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)
{ _name = joinedName,
_kind = LSP.SymbolKind_Object,
_children =
Just
(mapMaybe documentSymbolForField fields)
}
where
joinedName = decodeUtf8 fieldName <> " " <> onelineSectionArgs sectionArgs
range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` joinedName
-- | Creates a single point LSP range
-- using cabal position
cabalPositionToLSPRange :: Position -> LSP.Range
cabalPositionToLSPRange pos = LSP.Range lspPos lspPos
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)))
defDocumentSymbol :: LSP.Range -> DocumentSymbol
defDocumentSymbol range = DocumentSymbol
{ _detail = Nothing
, _deprecated = Nothing
, _name = ""
, _kind = LSP.SymbolKind_File
, _range = range
, _selectionRange = range
, _children = Nothing
, _tags = Nothing
}

2
plugins/hls-cabal-plugin/test/Main.hs
View File

@ -20,6 +20,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
@ -33,6 +34,7 @@ main = do
, pluginTests
, completerTests
, contextTests
, outlineTests
, codeActionTests
]

103
plugins/hls-cabal-plugin/test/Outline.hs Normal file
View File

@ -0,0 +1,103 @@
{-# LANGUAGE OverloadedStrings #-}
module Outline (
outlineTests,
) where
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 =
runCabalTestCaseSession testName "outline-cabal" $ do
docId <- T.openDoc path "cabal"
symbols <- T.getDocumentSymbols docId
T.liftIO $ symbols T.@?= Right expectedSymbols
outlineTests :: T.TestTree
outlineTests =
T.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 :: 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
}

1
plugins/hls-cabal-plugin/test/testdata/outline-cabal/field.cabal vendored Normal file
View File

@ -0,0 +1 @@
homepage:

1
plugins/hls-cabal-plugin/test/testdata/outline-cabal/fieldline.cabal vendored Normal file
View File

@ -0,0 +1 @@
cabal-version: 3.0

2
plugins/hls-cabal-plugin/test/testdata/outline-cabal/section.cabal vendored Normal file
View File

@ -0,0 +1,2 @@
build-depends:
base >=4.16 && <5

2
plugins/hls-cabal-plugin/test/testdata/outline-cabal/sectionarg.cabal vendored Normal file
View File

@ -0,0 +1,2 @@
if os(windows)
build-depends: Win32

3
test/testdata/schema/ghc94/default-config.golden.json vendored
View File

@ -11,7 +11,8 @@
"cabal": {
"codeActionsOn": true,
"completionOn": true,
"diagnosticsOn": true
"diagnosticsOn": true,
"symbolsOn": true
},
"cabal-fmt": {
"config": {

6
test/testdata/schema/ghc94/vscode-extension-schema.golden.json vendored
View File

@ -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",

3
test/testdata/schema/ghc96/default-config.golden.json vendored
View File

@ -11,7 +11,8 @@
"cabal": {
"codeActionsOn": true,
"completionOn": true,
"diagnosticsOn": true
"diagnosticsOn": true,
"symbolsOn": true
},
"cabal-fmt": {
"config": {

6
test/testdata/schema/ghc96/vscode-extension-schema.golden.json vendored
View File

@ -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",

3
test/testdata/schema/ghc98/default-config.golden.json vendored
View File

@ -11,7 +11,8 @@
"cabal": {
"codeActionsOn": true,
"completionOn": true,
"diagnosticsOn": true
"diagnosticsOn": true,
"symbolsOn": true
},
"cabal-fmt": {
"config": {

6
test/testdata/schema/ghc98/vscode-extension-schema.golden.json vendored
View File

@ -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",