Skip to content

Commit 5ca06a1

Browse files
Document symbols provider (#293)
* Document symbols provider * Compatibility with GHC 8.4 * Replace large number with more descriptive maxBound Co-Authored-By: Andreas Herrmann <[email protected]> * Use SkFunction for all Val Declarations * Improve outlining of PatBind and FunBind No longer relying on gfindtype Co-authored-by: Andreas Herrmann <[email protected]>
1 parent 0bcdc6a commit 5ca06a1

File tree

9 files changed

+410
-6
lines changed

9 files changed

+410
-6
lines changed

ghcide.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -130,6 +130,7 @@ library
130130
Development.IDE.LSP.Completions
131131
Development.IDE.LSP.HoverDefinition
132132
Development.IDE.LSP.Notifications
133+
Development.IDE.LSP.Outline
133134
Development.IDE.Spans.AtPoint
134135
Development.IDE.Spans.Calculate
135136
Development.IDE.Spans.Documentation

src/Development/IDE/Core/Preprocessor.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,6 @@ module Development.IDE.Core.Preprocessor
88
import Development.IDE.GHC.CPP
99
import Development.IDE.GHC.Orphans()
1010
import Development.IDE.GHC.Compat
11-
import GHC
1211
import GhcMonad
1312
import StringBuffer as SB
1413

src/Development/IDE/Core/Rules.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,7 @@ import Development.IDE.Core.RuleTypes
5656

5757
import GHC hiding (parseModule, typecheckModule)
5858
import qualified GHC.LanguageExtensions as LangExt
59-
import Development.IDE.GHC.Compat
59+
import Development.IDE.GHC.Compat (hie_file_result, readHieFile)
6060
import UniqSupply
6161
import NameCache
6262
import HscTypes

src/Development/IDE/GHC/Compat.hs

Lines changed: 60 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
-- SPDX-License-Identifier: Apache-2.0
33

44
{-# LANGUAGE CPP #-}
5+
{-# LANGUAGE PatternSynonyms #-}
56
#include "ghc-api-version.h"
67

78
-- | Attempt at hiding the GHC version differences we can.
@@ -15,7 +16,14 @@ module Development.IDE.GHC.Compat(
1516
includePathsGlobal,
1617
includePathsQuote,
1718
addIncludePathsQuote,
18-
ghcEnumerateExtensions
19+
ghcEnumerateExtensions,
20+
pattern DerivD,
21+
pattern ForD,
22+
pattern InstD,
23+
pattern TyClD,
24+
pattern ValD,
25+
pattern ClassOpSig,
26+
module GHC
1927
) where
2028

2129
import StringBuffer
@@ -26,12 +34,14 @@ import GHC.LanguageExtensions.Type
2634
import Data.List.Extra (enumerate)
2735
#endif
2836

37+
import qualified GHC
38+
import GHC hiding (ClassOpSig, DerivD, ForD, InstD, TyClD, ValD)
39+
2940
#if MIN_GHC_API_VERSION(8,8,0)
3041
import HieAst
3142
import HieBin
3243
import HieTypes
3344
#else
34-
import GHC
3545
import GhcPlugins
3646
import NameCache
3747
import Avail
@@ -83,3 +93,51 @@ ghcEnumerateExtensions = [Cpp .. StarIsType]
8393
#else
8494
ghcEnumerateExtensions = [Cpp .. EmptyDataDeriving]
8595
#endif
96+
97+
pattern DerivD :: DerivDecl p -> HsDecl p
98+
pattern DerivD x <-
99+
#if MIN_GHC_API_VERSION(8,6,0)
100+
GHC.DerivD _ x
101+
#else
102+
GHC.DerivD x
103+
#endif
104+
105+
pattern ForD :: ForeignDecl p -> HsDecl p
106+
pattern ForD x <-
107+
#if MIN_GHC_API_VERSION(8,6,0)
108+
GHC.ForD _ x
109+
#else
110+
GHC.ForD x
111+
#endif
112+
113+
pattern ValD :: HsBind p -> HsDecl p
114+
pattern ValD x <-
115+
#if MIN_GHC_API_VERSION(8,6,0)
116+
GHC.ValD _ x
117+
#else
118+
GHC.ValD x
119+
#endif
120+
121+
pattern InstD :: InstDecl p -> HsDecl p
122+
pattern InstD x <-
123+
#if MIN_GHC_API_VERSION(8,6,0)
124+
GHC.InstD _ x
125+
#else
126+
GHC.InstD x
127+
#endif
128+
129+
pattern TyClD :: TyClDecl p -> HsDecl p
130+
pattern TyClD x <-
131+
#if MIN_GHC_API_VERSION(8,6,0)
132+
GHC.TyClD _ x
133+
#else
134+
GHC.TyClD x
135+
#endif
136+
137+
pattern ClassOpSig :: Bool -> [Located (IdP pass)] -> LHsSigType pass -> Sig pass
138+
pattern ClassOpSig a b c <-
139+
#if MIN_GHC_API_VERSION(8,6,0)
140+
GHC.ClassOpSig _ a b c
141+
#else
142+
GHC.ClassOpSig a b c
143+
#endif

src/Development/IDE/GHC/Error.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ module Development.IDE.GHC.Error
1212

1313
-- * utilities working with spans
1414
, srcSpanToLocation
15+
, srcSpanToRange
1516
, srcSpanToFilename
1617
, zeroSpan
1718
, realSpan

src/Development/IDE/LSP/LanguageServer.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ import Development.IDE.LSP.HoverDefinition
3232
import Development.IDE.LSP.CodeAction
3333
import Development.IDE.LSP.Completions
3434
import Development.IDE.LSP.Notifications
35+
import Development.IDE.LSP.Outline
3536
import Development.IDE.Core.Service
3637
import Development.IDE.Types.Logger
3738
import Development.IDE.Core.FileStore
@@ -99,6 +100,7 @@ runLanguageServer options userHandlers getIdeState = do
99100
setHandlersDefinition <> setHandlersHover <>
100101
setHandlersCodeAction <> setHandlersCodeLens <> -- useful features someone may override
101102
setHandlersCompletion <>
103+
setHandlersOutline <>
102104
userHandlers <>
103105
setHandlersNotifications <> -- absolutely critical, join them with user notifications
104106
cancelHandler cancelRequest

src/Development/IDE/LSP/Outline.hs

Lines changed: 195 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,195 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE DuplicateRecordFields #-}
3+
#include "ghc-api-version.h"
4+
5+
module Development.IDE.LSP.Outline
6+
( setHandlersOutline
7+
)
8+
where
9+
10+
import qualified Language.Haskell.LSP.Core as LSP
11+
import Language.Haskell.LSP.Messages
12+
import Language.Haskell.LSP.Types
13+
import Data.Functor
14+
import Data.Generics
15+
import Data.Maybe
16+
import Data.Text ( Text
17+
, pack
18+
)
19+
import qualified Data.Text as T
20+
import Development.IDE.Core.Rules
21+
import Development.IDE.Core.Shake
22+
import Development.IDE.GHC.Compat
23+
import Development.IDE.GHC.Error ( srcSpanToRange )
24+
import Development.IDE.LSP.Server
25+
import Development.IDE.Types.Location
26+
import Outputable ( Outputable
27+
, ppr
28+
, showSDocUnsafe
29+
)
30+
31+
setHandlersOutline :: PartialHandlers
32+
setHandlersOutline = PartialHandlers $ \WithMessage {..} x -> return x
33+
{ LSP.documentSymbolHandler = withResponse RspDocumentSymbols moduleOutline
34+
}
35+
36+
moduleOutline
37+
:: LSP.LspFuncs () -> IdeState -> DocumentSymbolParams -> IO DSResult
38+
moduleOutline _lsp ideState DocumentSymbolParams { _textDocument = TextDocumentIdentifier uri }
39+
= case uriToFilePath uri of
40+
Just (toNormalizedFilePath -> fp) -> do
41+
mb_decls <- runAction ideState $ use GetParsedModule fp
42+
pure $ case mb_decls of
43+
Nothing -> DSDocumentSymbols (List [])
44+
Just (ParsedModule { pm_parsed_source = L _ltop HsModule { hsmodName, hsmodDecls, hsmodImports } })
45+
-> let
46+
declSymbols = mapMaybe documentSymbolForDecl hsmodDecls
47+
moduleSymbol = hsmodName <&> \(L l m) ->
48+
(defDocumentSymbol l :: DocumentSymbol)
49+
{ _name = pprText m
50+
, _kind = SkFile
51+
, _range = Range (Position 0 0) (Position maxBound 0) -- _ltop is 0 0 0 0
52+
}
53+
importSymbols = mapMaybe documentSymbolForImport hsmodImports
54+
allSymbols = case moduleSymbol of
55+
Nothing -> importSymbols <> declSymbols
56+
Just x ->
57+
[ x { _children = Just (List (importSymbols <> declSymbols))
58+
}
59+
]
60+
in
61+
DSDocumentSymbols (List allSymbols)
62+
63+
64+
Nothing -> pure $ DSDocumentSymbols (List [])
65+
66+
documentSymbolForDecl :: Located (HsDecl GhcPs) -> Maybe DocumentSymbol
67+
documentSymbolForDecl (L l (TyClD FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } }))
68+
= Just (defDocumentSymbol l :: DocumentSymbol)
69+
{ _name = showRdrName n
70+
<> (case pprText fdTyVars of
71+
"" -> ""
72+
t -> " " <> t
73+
)
74+
, _detail = Just $ pprText fdInfo
75+
, _kind = SkClass
76+
}
77+
documentSymbolForDecl (L l (TyClD ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars }))
78+
= Just (defDocumentSymbol l :: DocumentSymbol)
79+
{ _name = showRdrName name
80+
<> (case pprText tcdTyVars of
81+
"" -> ""
82+
t -> " " <> t
83+
)
84+
, _kind = SkClass
85+
, _detail = Just "class"
86+
, _children =
87+
Just $ List
88+
[ (defDocumentSymbol l :: DocumentSymbol)
89+
{ _name = showRdrName n
90+
, _kind = SkMethod
91+
, _selectionRange = srcSpanToRange l'
92+
}
93+
| L l (ClassOpSig False names _) <- tcdSigs
94+
, L l' n <- names
95+
]
96+
}
97+
documentSymbolForDecl (L l (TyClD DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } }))
98+
= Just (defDocumentSymbol l :: DocumentSymbol)
99+
{ _name = showRdrName name
100+
, _kind = SkStruct
101+
, _children =
102+
Just $ List
103+
[ (defDocumentSymbol l :: DocumentSymbol)
104+
{ _name = showRdrName n
105+
, _kind = SkConstructor
106+
, _selectionRange = srcSpanToRange l'
107+
}
108+
| L l x <- dd_cons
109+
, L l' n <- getConNames x
110+
]
111+
}
112+
documentSymbolForDecl (L l (TyClD SynDecl { tcdLName = L l' n })) = Just
113+
(defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName n
114+
, _kind = SkTypeParameter
115+
, _selectionRange = srcSpanToRange l'
116+
}
117+
documentSymbolForDecl (L l (InstD (ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } })))
118+
= Just (defDocumentSymbol l :: DocumentSymbol) { _name = pprText cid_poly_ty
119+
, _kind = SkInterface
120+
}
121+
documentSymbolForDecl (L l (InstD DataFamInstD { dfid_inst = DataFamInstDecl (HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } }) }))
122+
= Just (defDocumentSymbol l :: DocumentSymbol)
123+
{ _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
124+
(map pprText feqn_pats)
125+
, _kind = SkInterface
126+
}
127+
documentSymbolForDecl (L l (InstD TyFamInstD { tfid_inst = TyFamInstDecl (HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } }) }))
128+
= Just (defDocumentSymbol l :: DocumentSymbol)
129+
{ _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
130+
(map pprText feqn_pats)
131+
, _kind = SkInterface
132+
}
133+
documentSymbolForDecl (L l (DerivD DerivDecl { deriv_type })) =
134+
gfindtype deriv_type <&> \(L (_ :: SrcSpan) name) ->
135+
(defDocumentSymbol l :: DocumentSymbol) { _name = pprText @(HsType GhcPs)
136+
name
137+
, _kind = SkInterface
138+
}
139+
documentSymbolForDecl (L l (ValD FunBind{fun_id = L _ name})) = Just
140+
(defDocumentSymbol l :: DocumentSymbol)
141+
{ _name = showRdrName name
142+
, _kind = SkFunction
143+
}
144+
documentSymbolForDecl (L l (ValD PatBind{pat_lhs})) = Just
145+
(defDocumentSymbol l :: DocumentSymbol)
146+
{ _name = pprText pat_lhs
147+
, _kind = SkFunction
148+
}
149+
150+
documentSymbolForDecl (L l (ForD x)) = Just
151+
(defDocumentSymbol l :: DocumentSymbol)
152+
{ _name = case x of
153+
ForeignImport{} -> name
154+
ForeignExport{} -> name
155+
#if MIN_GHC_API_VERSION(8,6,0)
156+
XForeignDecl{} -> "?"
157+
#endif
158+
, _kind = SkObject
159+
, _detail = case x of
160+
ForeignImport{} -> Just "import"
161+
ForeignExport{} -> Just "export"
162+
#if MIN_GHC_API_VERSION(8,6,0)
163+
XForeignDecl{} -> Nothing
164+
#endif
165+
}
166+
where name = showRdrName $ unLoc $ fd_name x
167+
168+
documentSymbolForDecl _ = Nothing
169+
170+
documentSymbolForImport :: Located (ImportDecl GhcPs) -> Maybe DocumentSymbol
171+
documentSymbolForImport (L l ImportDecl { ideclName, ideclQualified }) = Just
172+
(defDocumentSymbol l :: DocumentSymbol)
173+
{ _name = "import " <> pprText ideclName
174+
, _kind = SkModule
175+
, _detail = if ideclQualified then Just "qualified" else Nothing
176+
}
177+
#if MIN_GHC_API_VERSION(8,6,0)
178+
documentSymbolForImport (L _ XImportDecl {}) = Nothing
179+
#endif
180+
181+
defDocumentSymbol :: SrcSpan -> DocumentSymbol
182+
defDocumentSymbol l = DocumentSymbol { .. } where
183+
_detail = Nothing
184+
_deprecated = Nothing
185+
_name = ""
186+
_kind = SkUnknown 0
187+
_range = srcSpanToRange l
188+
_selectionRange = srcSpanToRange l
189+
_children = Nothing
190+
191+
showRdrName :: RdrName -> Text
192+
showRdrName = pprText
193+
194+
pprText :: Outputable a => a -> Text
195+
pprText = pack . showSDocUnsafe . ppr

src/Development/IDE/Spans/AtPoint.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,6 @@ import Development.IDE.Spans.Type as SpanInfo
2222

2323
-- GHC API imports
2424
import Avail
25-
import GHC
2625
import DynFlags
2726
import FastString
2827
import Name

0 commit comments

Comments
 (0)