|
| 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 |
0 commit comments