Skip to content

Commit 0bf3348

Browse files
VenInffendor
VenInf
and
fendor
authored
Cabal plugin outline view (#4323)
* 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 f77dea5. * + docs, refactoring * Update plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs * formatting * newline --------- Co-authored-by: fendor <[email protected]>
1 parent a4bcaa3 commit 0bf3348

17 files changed

+282
-4
lines changed

‎haskell-language-server.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -245,6 +245,7 @@ library hls-cabal-plugin
245245
Ide.Plugin.Cabal.FieldSuggest
246246
Ide.Plugin.Cabal.LicenseSuggest
247247
Ide.Plugin.Cabal.Orphans
248+
Ide.Plugin.Cabal.Outline
248249
Ide.Plugin.Cabal.Parse
249250

250251

@@ -282,6 +283,7 @@ test-suite hls-cabal-plugin-tests
282283
Completer
283284
Context
284285
Utils
286+
Outline
285287
build-depends:
286288
, base
287289
, bytestring

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
4141
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
4242
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
4343
import Ide.Plugin.Cabal.Orphans ()
44+
import Ide.Plugin.Cabal.Outline
4445
import qualified Ide.Plugin.Cabal.Parse as Parse
4546
import Ide.Types
4647
import qualified Language.LSP.Protocol.Lens as JL
@@ -90,6 +91,7 @@ descriptor recorder plId =
9091
mconcat
9192
[ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction
9293
, mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder
94+
, mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline
9395
, mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
9496
]
9597
, pluginNotificationHandlers =

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

Lines changed: 17 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, getOptionalSectionName, getAnnotation, getFieldName) where
1+
module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, getOptionalSectionName, getAnnotation, getFieldName, onelineSectionArgs) where
22

33
import Data.List.NonEmpty (NonEmpty)
44
import qualified Data.List.NonEmpty as NE
@@ -66,3 +66,19 @@ getOptionalSectionName (x:xs) = case x of
6666
Syntax.SecArgName _ name -> Just (T.decodeUtf8 name)
6767
_ -> getOptionalSectionName xs
6868

69+
70+
-- | Makes a single text line out of multiple
71+
-- @SectionArg@s. Allows to display conditions,
72+
-- flags, etc in one line, which is easier to read.
73+
--
74+
-- For example, @flag@ @(@ @pedantic@ @)@ will be joined in
75+
-- one line, instead of four @SectionArg@s separately.
76+
onelineSectionArgs :: [Syntax.SectionArg Syntax.Position] -> T.Text
77+
onelineSectionArgs sectionArgs = joinedName
78+
where
79+
joinedName = T.unwords $ map getName sectionArgs
80+
81+
getName :: Syntax.SectionArg Syntax.Position -> T.Text
82+
getName (Syntax.SecArgName _ identifier) = T.decodeUtf8 identifier
83+
getName (Syntax.SecArgStr _ quotedString) = T.decodeUtf8 quotedString
84+
getName (Syntax.SecArgOther _ string) = T.decodeUtf8 string

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -180,3 +180,10 @@ lspPositionToCabalPosition :: Position -> Syntax.Position
180180
lspPositionToCabalPosition pos = Syntax.Position
181181
(fromIntegral (pos ^. JL.line) + 1)
182182
(fromIntegral (pos ^. JL.character) + 1)
183+
184+
-- | Convert an 'Syntax.Position' to a LSP 'Position'.
185+
--
186+
-- Cabal Positions start their indexing at 1 while LSP starts at 0.
187+
-- This helper makes sure, the translation is done properly.
188+
cabalPositionToLSPPosition :: Syntax.Position -> Position
189+
cabalPositionToLSPPosition (Syntax.Position start end) = Position (toEnum start -1) (toEnum end -1)

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Outline.hs

Lines changed: 119 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,119 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE DuplicateRecordFields #-}
4+
{-# LANGUAGE GADTs #-}
5+
{-# LANGUAGE OverloadedStrings #-}
6+
{-# LANGUAGE ViewPatterns #-}
7+
8+
module Ide.Plugin.Cabal.Outline where
9+
10+
import Control.Monad.IO.Class
11+
import Data.Maybe
12+
import qualified Data.Text as T
13+
import Data.Text.Encoding (decodeUtf8)
14+
import Development.IDE.Core.Rules
15+
import Development.IDE.Core.Shake (IdeState (shakeExtras),
16+
runIdeAction,
17+
useWithStaleFast)
18+
import Development.IDE.Types.Location (toNormalizedFilePath')
19+
import Distribution.Fields.Field (Field (Field, Section),
20+
Name (Name))
21+
import Distribution.Parsec.Position (Position)
22+
import Ide.Plugin.Cabal.Completion.CabalFields (onelineSectionArgs)
23+
import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..),
24+
cabalPositionToLSPPosition)
25+
import Ide.Plugin.Cabal.Orphans ()
26+
import Ide.Types (PluginMethodHandler)
27+
import Language.LSP.Protocol.Message (Method (..))
28+
import Language.LSP.Protocol.Types (DocumentSymbol (..))
29+
import qualified Language.LSP.Protocol.Types as LSP
30+
31+
32+
moduleOutline :: PluginMethodHandler IdeState Method_TextDocumentDocumentSymbol
33+
moduleOutline ideState _ LSP.DocumentSymbolParams {_textDocument = LSP.TextDocumentIdentifier uri} =
34+
case LSP.uriToFilePath uri of
35+
Just (toNormalizedFilePath' -> fp) -> do
36+
mFields <- liftIO $ runIdeAction "cabal-plugin.fields" (shakeExtras ideState) (useWithStaleFast ParseCabalFields fp)
37+
case fmap fst mFields of
38+
Just fieldPositions -> pure $ LSP.InR (LSP.InL allSymbols)
39+
where
40+
allSymbols = mapMaybe documentSymbolForField fieldPositions
41+
Nothing -> pure $ LSP.InL []
42+
Nothing -> pure $ LSP.InL []
43+
44+
-- | Creates a @DocumentSymbol@ object for the
45+
-- cabal AST, without displaying @fieldLines@ and
46+
-- displaying @Section Name@ and @SectionArgs@ in one line.
47+
--
48+
-- @fieldLines@ are leaves of a cabal AST, so they are omitted
49+
-- in the outline. Sections have to be displayed in one line, because
50+
-- the AST representation looks unnatural. See examples:
51+
--
52+
-- * part of a cabal file:
53+
--
54+
-- > if impl(ghc >= 9.8)
55+
-- > ghc-options: -Wall
56+
--
57+
-- * AST representation:
58+
--
59+
-- > if
60+
-- > impl
61+
-- > (
62+
-- > ghc >= 9.8
63+
-- > )
64+
-- >
65+
-- > ghc-options:
66+
-- > -Wall
67+
--
68+
-- * resulting @DocumentSymbol@:
69+
--
70+
-- > if impl(ghc >= 9.8)
71+
-- > ghc-options:
72+
-- >
73+
documentSymbolForField :: Field Position -> Maybe DocumentSymbol
74+
documentSymbolForField (Field (Name pos fieldName) _) =
75+
Just
76+
(defDocumentSymbol range)
77+
{ _name = decodeUtf8 fieldName,
78+
_kind = LSP.SymbolKind_Field,
79+
_children = Nothing
80+
}
81+
where
82+
range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` decodeUtf8 fieldName
83+
documentSymbolForField (Section (Name pos fieldName) sectionArgs fields) =
84+
Just
85+
(defDocumentSymbol range)
86+
{ _name = joinedName,
87+
_kind = LSP.SymbolKind_Object,
88+
_children =
89+
Just
90+
(mapMaybe documentSymbolForField fields)
91+
}
92+
where
93+
joinedName = decodeUtf8 fieldName <> " " <> onelineSectionArgs sectionArgs
94+
range = cabalPositionToLSPRange pos `addNameLengthToLSPRange` joinedName
95+
96+
-- | Creates a single point LSP range
97+
-- using cabal position
98+
cabalPositionToLSPRange :: Position -> LSP.Range
99+
cabalPositionToLSPRange pos = LSP.Range lspPos lspPos
100+
where
101+
lspPos = cabalPositionToLSPPosition pos
102+
103+
addNameLengthToLSPRange :: LSP.Range -> T.Text -> LSP.Range
104+
addNameLengthToLSPRange (LSP.Range pos1 (LSP.Position line char)) name =
105+
LSP.Range
106+
pos1
107+
(LSP.Position line (char + fromIntegral (T.length name)))
108+
109+
defDocumentSymbol :: LSP.Range -> DocumentSymbol
110+
defDocumentSymbol range = DocumentSymbol
111+
{ _detail = Nothing
112+
, _deprecated = Nothing
113+
, _name = ""
114+
, _kind = LSP.SymbolKind_File
115+
, _range = range
116+
, _selectionRange = range
117+
, _children = Nothing
118+
, _tags = Nothing
119+
}

‎plugins/hls-cabal-plugin/test/Main.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ import qualified Data.Text as Text
2020
import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion)
2121
import qualified Ide.Plugin.Cabal.Parse as Lib
2222
import qualified Language.LSP.Protocol.Lens as L
23+
import Outline (outlineTests)
2324
import System.FilePath
2425
import Test.Hls
2526
import Utils
@@ -33,6 +34,7 @@ main = do
3334
, pluginTests
3435
, completerTests
3536
, contextTests
37+
, outlineTests
3638
, codeActionTests
3739
]
3840

‎plugins/hls-cabal-plugin/test/Outline.hs

Lines changed: 103 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,103 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
module Outline (
4+
outlineTests,
5+
) where
6+
7+
import Language.LSP.Protocol.Types (DocumentSymbol (..),
8+
Position (..), Range (..))
9+
import qualified Test.Hls as T
10+
import Utils
11+
12+
testSymbols :: (T.HasCallStack) => T.TestName -> FilePath -> [DocumentSymbol] -> T.TestTree
13+
testSymbols testName path expectedSymbols =
14+
runCabalTestCaseSession testName "outline-cabal" $ do
15+
docId <- T.openDoc path "cabal"
16+
symbols <- T.getDocumentSymbols docId
17+
T.liftIO $ symbols T.@?= Right expectedSymbols
18+
19+
outlineTests :: T.TestTree
20+
outlineTests =
21+
T.testGroup
22+
"Cabal Outline Tests"
23+
[ testSymbols
24+
"cabal Field outline test"
25+
"field.cabal"
26+
[fieldDocumentSymbol]
27+
, testSymbols
28+
"cabal FieldLine outline test"
29+
"fieldline.cabal"
30+
[fieldLineDocumentSymbol]
31+
, testSymbols
32+
"cabal Section outline test"
33+
"section.cabal"
34+
[sectionDocumentSymbol]
35+
, testSymbols
36+
"cabal SectionArg outline test"
37+
"sectionarg.cabal"
38+
[sectionArgDocumentSymbol]
39+
]
40+
where
41+
fieldDocumentSymbol :: DocumentSymbol
42+
fieldDocumentSymbol =
43+
( defDocumentSymbol
44+
( Range { _start = Position{_line = 0, _character = 0}
45+
, _end = Position{_line = 0, _character = 8} })
46+
)
47+
{ _name = "homepage"
48+
, _kind = T.SymbolKind_Field
49+
, _children = Nothing
50+
}
51+
fieldLineDocumentSymbol :: DocumentSymbol
52+
fieldLineDocumentSymbol =
53+
( defDocumentSymbol
54+
( Range { _start = Position{_line = 0, _character = 0}
55+
, _end = Position{_line = 0, _character = 13} })
56+
)
57+
{ _name = "cabal-version"
58+
, _kind = T.SymbolKind_Field
59+
, _children = Nothing -- the values of fieldLine are removed from the outline
60+
}
61+
sectionDocumentSymbol :: DocumentSymbol
62+
sectionDocumentSymbol =
63+
( defDocumentSymbol
64+
( Range { _start = Position{_line = 0, _character = 2}
65+
, _end = Position{_line = 0, _character = 15} })
66+
)
67+
{ _name = "build-depends"
68+
, _kind = T.SymbolKind_Field
69+
, _children = Nothing -- the values of fieldLine are removed from the outline
70+
}
71+
sectionArgDocumentSymbol :: DocumentSymbol
72+
sectionArgDocumentSymbol =
73+
( defDocumentSymbol
74+
( Range { _start = Position{_line = 0, _character = 2}
75+
, _end = Position{_line = 0, _character = 19} })
76+
)
77+
{ _name = "if os ( windows )"
78+
, _kind = T.SymbolKind_Object
79+
, _children = Just $ [sectionArgChildrenDocumentSymbol]
80+
}
81+
sectionArgChildrenDocumentSymbol :: DocumentSymbol
82+
sectionArgChildrenDocumentSymbol =
83+
( defDocumentSymbol
84+
( Range { _start = Position{_line = 1, _character = 4}
85+
, _end = Position{_line = 1, _character = 17} })
86+
)
87+
{ _name = "build-depends"
88+
, _kind = T.SymbolKind_Field
89+
, _children = Nothing
90+
}
91+
92+
defDocumentSymbol :: Range -> DocumentSymbol
93+
defDocumentSymbol range =
94+
DocumentSymbol
95+
{ _detail = Nothing
96+
, _deprecated = Nothing
97+
, _name = ""
98+
, _kind = T.SymbolKind_File
99+
, _range = range
100+
, _selectionRange = range
101+
, _children = Nothing
102+
, _tags = Nothing
103+
}

‎plugins/hls-cabal-plugin/test/testdata/outline-cabal/field.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
homepage:

‎plugins/hls-cabal-plugin/test/testdata/outline-cabal/fieldline.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
cabal-version: 3.0

‎plugins/hls-cabal-plugin/test/testdata/outline-cabal/section.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
build-depends:
2+
base >=4.16 && <5

‎plugins/hls-cabal-plugin/test/testdata/outline-cabal/sectionarg.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
if os(windows)
2+
build-depends: Win32

‎test/testdata/schema/ghc94/default-config.golden.json

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,8 @@
1111
"cabal": {
1212
"codeActionsOn": true,
1313
"completionOn": true,
14-
"diagnosticsOn": true
14+
"diagnosticsOn": true,
15+
"symbolsOn": true
1516
},
1617
"cabal-fmt": {
1718
"config": {

‎test/testdata/schema/ghc94/vscode-extension-schema.golden.json

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,12 @@
3535
"scope": "resource",
3636
"type": "boolean"
3737
},
38+
"haskell.plugin.cabal.symbolsOn": {
39+
"default": true,
40+
"description": "Enables cabal symbols",
41+
"scope": "resource",
42+
"type": "boolean"
43+
},
3844
"haskell.plugin.callHierarchy.globalOn": {
3945
"default": true,
4046
"description": "Enables callHierarchy plugin",

‎test/testdata/schema/ghc96/default-config.golden.json

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,8 @@
1111
"cabal": {
1212
"codeActionsOn": true,
1313
"completionOn": true,
14-
"diagnosticsOn": true
14+
"diagnosticsOn": true,
15+
"symbolsOn": true
1516
},
1617
"cabal-fmt": {
1718
"config": {

‎test/testdata/schema/ghc96/vscode-extension-schema.golden.json

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,12 @@
3535
"scope": "resource",
3636
"type": "boolean"
3737
},
38+
"haskell.plugin.cabal.symbolsOn": {
39+
"default": true,
40+
"description": "Enables cabal symbols",
41+
"scope": "resource",
42+
"type": "boolean"
43+
},
3844
"haskell.plugin.callHierarchy.globalOn": {
3945
"default": true,
4046
"description": "Enables callHierarchy plugin",

‎test/testdata/schema/ghc98/default-config.golden.json

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,8 @@
1111
"cabal": {
1212
"codeActionsOn": true,
1313
"completionOn": true,
14-
"diagnosticsOn": true
14+
"diagnosticsOn": true,
15+
"symbolsOn": true
1516
},
1617
"cabal-fmt": {
1718
"config": {

‎test/testdata/schema/ghc98/vscode-extension-schema.golden.json

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,12 @@
3535
"scope": "resource",
3636
"type": "boolean"
3737
},
38+
"haskell.plugin.cabal.symbolsOn": {
39+
"default": true,
40+
"description": "Enables cabal symbols",
41+
"scope": "resource",
42+
"type": "boolean"
43+
},
3844
"haskell.plugin.callHierarchy.globalOn": {
3945
"default": true,
4046
"description": "Enables callHierarchy plugin",

0 commit comments

Comments
 (0)