{-# LANGUAGE CPP                   #-}

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs                 #-}

module Development.IDE.LSP.Outline
  ( moduleOutline
  )
where

import           Control.Monad.IO.Class
import           Data.Foldable                  (toList)
import           Data.Functor
import           Data.Generics                  hiding (Prefix)
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)
import          Language.LSP.Protocol.Message

-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]

#if !MIN_VERSION_ghc(9,3,0)
import qualified Data.Text                      as T
#endif

moduleOutline
  :: PluginMethodHandler IdeState Method_TextDocumentDocumentSymbol
moduleOutline :: PluginMethodHandler IdeState 'Method_TextDocumentDocumentSymbol
moduleOutline IdeState
ideState PluginId
_ DocumentSymbolParams{ $sel:_textDocument:DocumentSymbolParams :: DocumentSymbolParams -> TextDocumentIdentifier
_textDocument = TextDocumentIdentifier Uri
uri }
  = IO (MessageResult 'Method_TextDocumentDocumentSymbol)
-> ExceptT
     PluginError
     (HandlerM Config)
     (MessageResult 'Method_TextDocumentDocumentSymbol)
forall a. IO a -> ExceptT PluginError (HandlerM Config) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MessageResult 'Method_TextDocumentDocumentSymbol)
 -> ExceptT
      PluginError
      (HandlerM Config)
      (MessageResult 'Method_TextDocumentDocumentSymbol))
-> IO (MessageResult 'Method_TextDocumentDocumentSymbol)
-> ExceptT
     PluginError
     (HandlerM Config)
     (MessageResult 'Method_TextDocumentDocumentSymbol)
forall a b. (a -> b) -> a -> b
$ case Uri -> Maybe FilePath
uriToFilePath Uri
uri of
    Just (FilePath -> NormalizedFilePath
toNormalizedFilePath' -> NormalizedFilePath
fp) -> do
      Maybe ParsedModule
mb_decls <- ((ParsedModule, PositionMapping) -> ParsedModule)
-> Maybe (ParsedModule, PositionMapping) -> Maybe ParsedModule
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParsedModule, PositionMapping) -> ParsedModule
forall a b. (a, b) -> a
fst (Maybe (ParsedModule, PositionMapping) -> Maybe ParsedModule)
-> IO (Maybe (ParsedModule, PositionMapping))
-> IO (Maybe ParsedModule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> IdeState
-> Action (Maybe (ParsedModule, PositionMapping))
-> IO (Maybe (ParsedModule, PositionMapping))
forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"Outline" IdeState
ideState (GetParsedModule
-> NormalizedFilePath
-> Action (Maybe (ParsedModule, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))
useWithStale GetParsedModule
GetParsedModule NormalizedFilePath
fp)
      ([SymbolInformation] |? ([DocumentSymbol] |? Null))
-> IO ([SymbolInformation] |? ([DocumentSymbol] |? Null))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([SymbolInformation] |? ([DocumentSymbol] |? Null))
 -> IO ([SymbolInformation] |? ([DocumentSymbol] |? Null)))
-> ([SymbolInformation] |? ([DocumentSymbol] |? Null))
-> IO ([SymbolInformation] |? ([DocumentSymbol] |? Null))
forall a b. (a -> b) -> a -> b
$ case Maybe ParsedModule
mb_decls of
        Maybe ParsedModule
Nothing -> [SymbolInformation]
-> [SymbolInformation] |? ([DocumentSymbol] |? Null)
forall a b. a -> a |? b
InL []
        Just ParsedModule { pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ltop HsModule { Maybe (XRec GhcPs ModuleName)
hsmodName :: Maybe (XRec GhcPs ModuleName)
hsmodName :: forall p. HsModule p -> Maybe (XRec p ModuleName)
hsmodName, [LHsDecl GhcPs]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls, [LImportDecl GhcPs]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports :: forall p. HsModule p -> [LImportDecl p]
hsmodImports } }
          -> let
               declSymbols :: [DocumentSymbol]
declSymbols  = (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Maybe DocumentSymbol)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> [DocumentSymbol]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LHsDecl GhcPs -> Maybe DocumentSymbol
GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Maybe DocumentSymbol
documentSymbolForDecl [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
hsmodDecls
               moduleSymbol :: Maybe DocumentSymbol
moduleSymbol = Maybe (XRec GhcPs ModuleName)
Maybe (GenLocated SrcSpanAnnA ModuleName)
hsmodName Maybe (GenLocated SrcSpanAnnA ModuleName)
-> (GenLocated SrcSpanAnnA ModuleName -> Maybe DocumentSymbol)
-> Maybe DocumentSymbol
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                 (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) ModuleName
m) -> DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (DocumentSymbol -> Maybe DocumentSymbol)
-> DocumentSymbol -> Maybe DocumentSymbol
forall a b. (a -> b) -> a -> b
$
                   (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
                     { _name  = printOutputable m
                     , _kind  = SymbolKind_File
                     , _range = Range (Position 0 0) (Position maxBound 0) -- _ltop is 0 0 0 0
                     }
                 GenLocated SrcSpanAnnA ModuleName
_ -> Maybe DocumentSymbol
forall a. Maybe a
Nothing
               importSymbols :: [DocumentSymbol]
importSymbols = [DocumentSymbol]
-> (DocumentSymbol -> [DocumentSymbol])
-> Maybe DocumentSymbol
-> [DocumentSymbol]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] DocumentSymbol -> [DocumentSymbol]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe DocumentSymbol -> [DocumentSymbol])
-> Maybe DocumentSymbol -> [DocumentSymbol]
forall a b. (a -> b) -> a -> b
$
                  [DocumentSymbol] -> Maybe DocumentSymbol
documentSymbolForImportSummary
                    ((GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Maybe DocumentSymbol)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> [DocumentSymbol]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LImportDecl GhcPs -> Maybe DocumentSymbol
GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Maybe DocumentSymbol
documentSymbolForImport [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
hsmodImports)
               allSymbols :: [DocumentSymbol]
allSymbols    = case Maybe DocumentSymbol
moduleSymbol of
                 Maybe DocumentSymbol
Nothing -> [DocumentSymbol]
importSymbols [DocumentSymbol] -> [DocumentSymbol] -> [DocumentSymbol]
forall a. Semigroup a => a -> a -> a
<> [DocumentSymbol]
declSymbols
                 Just DocumentSymbol
x ->
                   [ DocumentSymbol
x { _children = Just (importSymbols <> declSymbols)
                       }
                   ]
             in
               ([DocumentSymbol] |? Null)
-> [SymbolInformation] |? ([DocumentSymbol] |? Null)
forall a b. b -> a |? b
InR ([DocumentSymbol] -> [DocumentSymbol] |? Null
forall a b. a -> a |? b
InL [DocumentSymbol]
allSymbols)


    Maybe FilePath
Nothing -> MessageResult 'Method_TextDocumentDocumentSymbol
-> IO (MessageResult 'Method_TextDocumentDocumentSymbol)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MessageResult 'Method_TextDocumentDocumentSymbol
 -> IO (MessageResult 'Method_TextDocumentDocumentSymbol))
-> MessageResult 'Method_TextDocumentDocumentSymbol
-> IO (MessageResult 'Method_TextDocumentDocumentSymbol)
forall a b. (a -> b) -> a -> b
$ [SymbolInformation]
-> [SymbolInformation] |? ([DocumentSymbol] |? Null)
forall a b. a -> a |? b
InL []

documentSymbolForDecl :: LHsDecl GhcPs -> Maybe DocumentSymbol
documentSymbolForDecl :: LHsDecl GhcPs -> Maybe DocumentSymbol
documentSymbolForDecl (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (TyClD XTyClD GhcPs
_ FamDecl { tcdFam :: forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam = FamilyDecl { fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName = L SrcSpanAnnN
_ RdrName
n, FamilyInfo GhcPs
fdInfo :: FamilyInfo GhcPs
fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo, LHsQTyVars GhcPs
fdTyVars :: LHsQTyVars GhcPs
fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdTyVars } }))
  = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
    { _name   = printOutputable n
                  <> (case printOutputable fdTyVars of
                       Text
"" -> Text
""
                       Text
t  -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
                     )
    , _detail = Just $ printOutputable fdInfo
    , _kind   = SymbolKind_Function
    }
documentSymbolForDecl (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (TyClD XTyClD GhcPs
_ ClassDecl { tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = L SrcSpanAnnN
_ RdrName
name, [LSig GhcPs]
tcdSigs :: [LSig GhcPs]
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs, LHsQTyVars GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars }))
  = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
    { _name     = printOutputable name
                    <> (case printOutputable tcdTyVars of
                         Text
"" -> Text
""
                         Text
t  -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
                       )
    , _kind     = SymbolKind_Interface
    , _detail   = Just "class"
    , _children =
      Just $
        [ (defDocumentSymbol l' :: DocumentSymbol)
            { _name           = printOutputable n
            , _kind           = SymbolKind_Method
            , _selectionRange = realSrcSpanToRange l''
            }
        | L (locA -> (RealSrcSpan l' _))  (ClassOpSig _ False names _) <- tcdSigs
        , L (locA -> (RealSrcSpan l'' _)) n                            <- names
        ]
    }
documentSymbolForDecl (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (TyClD XTyClD GhcPs
_ DataDecl { tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = L SrcSpanAnnN
_ RdrName
name, tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn { DataDefnCons (LConDecl GhcPs)
dd_cons :: DataDefnCons (LConDecl GhcPs)
dd_cons :: forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons } }))
  = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
    { _name     = printOutputable name
    , _kind     = SymbolKind_Struct
    , _children =
      Just $
          [ (defDocumentSymbol l'' :: DocumentSymbol)
            { _name           = printOutputable n
            , _kind           = SymbolKind_Constructor
            , _selectionRange = realSrcSpanToRange l'
            , _children       = toList <$> nonEmpty childs
            }
        | con <- extract_cons dd_cons
        , let (cs, flds) = hsConDeclsBinders con
        , let childs = (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
 -> Maybe DocumentSymbol)
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
-> [DocumentSymbol]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LFieldOcc GhcPs -> Maybe DocumentSymbol
GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
-> Maybe DocumentSymbol
cvtFld [LFieldOcc GhcPs]
[GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
flds
        , L (locA -> RealSrcSpan l' _) n <- cs
        , let l'' = case GenLocated SrcSpanAnnA (ConDecl GhcPs)
con of
                L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> RealSrcSpan RealSrcSpan
l''' Maybe BufSpan
_) ConDecl GhcPs
_ -> RealSrcSpan
l'''
                GenLocated SrcSpanAnnA (ConDecl GhcPs)
_ -> RealSrcSpan
l'
        ]
    }
  where
    cvtFld :: LFieldOcc GhcPs -> Maybe DocumentSymbol
#if MIN_VERSION_ghc(9,3,0)
    cvtFld :: LFieldOcc GhcPs -> Maybe DocumentSymbol
cvtFld (L (SrcAnn NoEpAnns -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> RealSrcSpan RealSrcSpan
l' Maybe BufSpan
_) FieldOcc GhcPs
n) = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (DocumentSymbol -> Maybe DocumentSymbol)
-> DocumentSymbol -> Maybe DocumentSymbol
forall a b. (a -> b) -> a -> b
$ (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l' :: DocumentSymbol)
#else
    cvtFld (L (RealSrcSpan l' _) n) = Just $ (defDocumentSymbol l' :: DocumentSymbol)
#endif
#if MIN_VERSION_ghc(9,3,0)
                { _name = printOutputable (unLoc (foLabel n))
#else
                { _name = printOutputable (unLoc (rdrNameFieldOcc n))
#endif
                , _kind = SymbolKind_Field
                }
    cvtFld LFieldOcc GhcPs
_  = Maybe DocumentSymbol
forall a. Maybe a
Nothing
documentSymbolForDecl (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (TyClD XTyClD GhcPs
_ SynDecl { tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = L (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l' Maybe BufSpan
_)) RdrName
n })) = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just
  (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol) { _name           = printOutputable n
                                          , _kind           = SymbolKind_TypeParameter
                                          , _selectionRange = realSrcSpanToRange l'
                                          }
documentSymbolForDecl (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (InstD XInstD GhcPs
_ ClsInstD { cid_inst :: forall pass. InstDecl pass -> ClsInstDecl pass
cid_inst = ClsInstDecl { LHsSigType GhcPs
cid_poly_ty :: LHsSigType GhcPs
cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty } }))
  = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol) { _name = printOutputable cid_poly_ty
                                                 , _kind = SymbolKind_Interface
                                                 }
documentSymbolForDecl (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (InstD XInstD GhcPs
_ DataFamInstD { dfid_inst :: forall pass. InstDecl pass -> DataFamInstDecl pass
dfid_inst = DataFamInstDecl FamEqn { LIdP GhcPs
feqn_tycon :: LIdP GhcPs
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon, HsTyPats GhcPs
feqn_pats :: HsTyPats GhcPs
feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats } }))
  = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
    { _name =
#if MIN_VERSION_ghc(9,3,0)
        printOutputable $ pprHsArgsApp (unLoc feqn_tycon) Prefix (feqn_pats)
#else
        printOutputable (unLoc feqn_tycon) <> " " <> T.unwords
                (map printOutputable feqn_pats)
#endif
    , _kind = SymbolKind_Interface
    }
documentSymbolForDecl (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (InstD XInstD GhcPs
_ TyFamInstD { tfid_inst :: forall pass. InstDecl pass -> TyFamInstDecl pass
tfid_inst = TyFamInstDecl XCTyFamInstDecl GhcPs
_ FamEqn { LIdP GhcPs
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon :: LIdP GhcPs
feqn_tycon, HsTyPats GhcPs
feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats :: HsTyPats GhcPs
feqn_pats } }))
  = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
    { _name =
#if MIN_VERSION_ghc(9,3,0)
        printOutputable $ pprHsArgsApp (unLoc feqn_tycon) Prefix (feqn_pats)
#else
        printOutputable (unLoc feqn_tycon) <> " " <> T.unwords
                (map printOutputable feqn_pats)
#endif
    , _kind = SymbolKind_Interface
    }
documentSymbolForDecl (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (DerivD XDerivD GhcPs
_ DerivDecl { LHsSigWcType GhcPs
deriv_type :: LHsSigWcType GhcPs
deriv_type :: forall pass. DerivDecl pass -> LHsSigWcType pass
deriv_type })) =
  HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> Maybe (GenLocated SrcSpan (HsType GhcPs))
forall x y. (Data x, Typeable y) => x -> Maybe y
gfindtype LHsSigWcType GhcPs
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
deriv_type Maybe (GenLocated SrcSpan (HsType GhcPs))
-> (GenLocated SrcSpan (HsType GhcPs) -> DocumentSymbol)
-> Maybe DocumentSymbol
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(L (SrcSpan
_ :: SrcSpan) HsType GhcPs
name) ->
    (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol) { _name = printOutputable @(HsType GhcPs)
                                              name
                                            , _kind = SymbolKind_Interface
                                            }
documentSymbolForDecl (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (ValD XValD GhcPs
_ FunBind{fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = L SrcSpanAnnN
_ RdrName
name})) = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just
    (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
      { _name   = printOutputable name
      , _kind   = SymbolKind_Function
      }
documentSymbolForDecl (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (ValD XValD GhcPs
_ PatBind{LPat GhcPs
pat_lhs :: LPat GhcPs
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs})) = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just
    (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
      { _name   = printOutputable pat_lhs
      , _kind   = SymbolKind_Function
      }

documentSymbolForDecl (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (ForD XForD GhcPs
_ ForeignDecl GhcPs
x)) = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just
  (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
    { _name   = case x of
                  ForeignImport{} -> Text
name
                  ForeignExport{} -> Text
name
    , _kind   = SymbolKind_Object
    , _detail = case x of
                  ForeignImport{} -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"import"
                  ForeignExport{} -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"export"
    }
  where name :: Text
name = RdrName -> Text
forall a. Outputable a => a -> Text
printOutputable (RdrName -> Text) -> RdrName -> Text
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName -> RdrName
forall a b. (a -> b) -> a -> b
$ ForeignDecl GhcPs -> LIdP GhcPs
forall pass. ForeignDecl pass -> LIdP pass
fd_name ForeignDecl GhcPs
x

documentSymbolForDecl LHsDecl GhcPs
_ = Maybe DocumentSymbol
forall a. Maybe a
Nothing

-- | Wrap the Document imports into a hierarchical outline for
-- a better overview of symbols in scope.
-- If there are no imports, then no hierarchy will be created.
documentSymbolForImportSummary :: [DocumentSymbol] -> Maybe DocumentSymbol
documentSymbolForImportSummary :: [DocumentSymbol] -> Maybe DocumentSymbol
documentSymbolForImportSummary [] = Maybe DocumentSymbol
forall a. Maybe a
Nothing
documentSymbolForImportSummary [DocumentSymbol]
importSymbols =
    let
      -- safe because if we have no ranges then we don't take this branch
      mergeRanges :: [Range] -> Range
mergeRanges [Range]
xs = Position -> Position -> Range
Range ([Position] -> Position
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Position] -> Position) -> [Position] -> Position
forall a b. (a -> b) -> a -> b
$ (Range -> Position) -> [Range] -> [Position]
forall a b. (a -> b) -> [a] -> [b]
map Range -> Position
_start [Range]
xs) ([Position] -> Position
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Position] -> Position) -> [Position] -> Position
forall a b. (a -> b) -> a -> b
$ (Range -> Position) -> [Range] -> [Position]
forall a b. (a -> b) -> [a] -> [b]
map Range -> Position
_end [Range]
xs)
      importRange :: Range
importRange = [Range] -> Range
mergeRanges ([Range] -> Range) -> [Range] -> Range
forall a b. (a -> b) -> a -> b
$ (DocumentSymbol -> Range) -> [DocumentSymbol] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
map (\DocumentSymbol{Range
_range :: Range
$sel:_range:DocumentSymbol :: DocumentSymbol -> Range
_range} -> Range
_range) [DocumentSymbol]
importSymbols
    in
      DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol (NormalizedFilePath -> Range -> RealSrcSpan
rangeToRealSrcSpan NormalizedFilePath
"" Range
importRange))
          { _name = "imports"
          , _kind = SymbolKind_Module
          , _children = Just importSymbols
          }

documentSymbolForImport :: LImportDecl GhcPs -> Maybe DocumentSymbol
documentSymbolForImport :: LImportDecl GhcPs -> Maybe DocumentSymbol
documentSymbolForImport (L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) ImportDecl { XRec GhcPs ModuleName
ideclName :: XRec GhcPs ModuleName
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName, ImportDeclQualifiedStyle
ideclQualified :: ImportDeclQualifiedStyle
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified }) = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just
  (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
    { _name   = "import " <> printOutputable ideclName
    , _kind   = SymbolKind_Module
    , _detail = case ideclQualified of { ImportDeclQualifiedStyle
NotQualified -> Maybe Text
forall a. Maybe a
Nothing; ImportDeclQualifiedStyle
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"qualified" }
    }
documentSymbolForImport LImportDecl GhcPs
_ = Maybe DocumentSymbol
forall a. Maybe a
Nothing

defDocumentSymbol :: RealSrcSpan -> DocumentSymbol
defDocumentSymbol :: RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l = DocumentSymbol { Maybe Bool
Maybe [DocumentSymbol]
Maybe [SymbolTag]
Maybe Text
Text
Range
SymbolKind
forall a. Maybe a
$sel:_name:DocumentSymbol :: Text
$sel:_kind:DocumentSymbol :: SymbolKind
$sel:_children:DocumentSymbol :: Maybe [DocumentSymbol]
$sel:_detail:DocumentSymbol :: Maybe Text
$sel:_selectionRange:DocumentSymbol :: Range
$sel:_range:DocumentSymbol :: Range
_detail :: forall a. Maybe a
_deprecated :: forall a. Maybe a
_name :: Text
_kind :: SymbolKind
_range :: Range
_selectionRange :: Range
_children :: forall a. Maybe a
_tags :: forall a. Maybe a
$sel:_deprecated:DocumentSymbol :: Maybe Bool
$sel:_tags:DocumentSymbol :: Maybe [SymbolTag]
.. } where
  _detail :: Maybe a
_detail         = Maybe a
forall a. Maybe a
Nothing
  _deprecated :: Maybe a
_deprecated     = Maybe a
forall a. Maybe a
Nothing
  _name :: Text
_name           = Text
""
  -- This used to be SkUnknown 0, which is invalid, as SymbolKinds start at 1,
  -- therefore, I am replacing it with SymbolKind_File, which is the type for 1
  _kind :: SymbolKind
_kind           = SymbolKind
SymbolKind_File
  _range :: Range
_range          = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
l
  _selectionRange :: Range
_selectionRange = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
l
  _children :: Maybe a
_children       = Maybe a
forall a. Maybe a
Nothing
  _tags :: Maybe a
_tags           = Maybe a
forall a. Maybe a
Nothing

-- the version of getConNames for ghc9 is restricted to only the renaming phase
hsConDeclsBinders :: LConDecl GhcPs
                  -> ([LIdP GhcPs], [LFieldOcc GhcPs])
   -- See hsLTyClDeclBinders for what this does
   -- The function is boringly complicated because of the records
   -- And since we only have equality, we have to be a little careful
hsConDeclsBinders :: LConDecl GhcPs -> ([LIdP GhcPs], [LFieldOcc GhcPs])
hsConDeclsBinders LConDecl GhcPs
cons
  = LConDecl GhcPs -> ([LIdP GhcPs], [LFieldOcc GhcPs])
go LConDecl GhcPs
cons
  where
    go :: LConDecl GhcPs
       -> ([LIdP GhcPs], [LFieldOcc GhcPs])
    go :: LConDecl GhcPs -> ([LIdP GhcPs], [LFieldOcc GhcPs])
go LConDecl GhcPs
r
      -- Don't re-mangle the location of field names, because we don't
      -- have a record of the full location of the field declaration anyway
      = case GenLocated SrcSpanAnnA (ConDecl GhcPs) -> ConDecl GhcPs
forall l e. GenLocated l e -> e
unLoc LConDecl GhcPs
GenLocated SrcSpanAnnA (ConDecl GhcPs)
r of
           -- remove only the first occurrence of any seen field in order to
           -- avoid circumventing detection of duplicate fields (#9156)
           ConDeclGADT { con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_names = NonEmpty (LIdP GhcPs)
names, con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_args = HsConDeclGADTDetails GhcPs
args }
             -> (NonEmpty (GenLocated SrcSpanAnnN RdrName)
-> [GenLocated SrcSpanAnnN RdrName]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (LIdP GhcPs)
NonEmpty (GenLocated SrcSpanAnnN RdrName)
names, [LFieldOcc GhcPs]
flds)
             where
                flds :: [LFieldOcc GhcPs]
flds = HsConDeclGADTDetails GhcPs -> [LFieldOcc GhcPs]
get_flds_gadt HsConDeclGADTDetails GhcPs
args

           ConDeclH98 { con_name :: forall pass. ConDecl pass -> LIdP pass
con_name = LIdP GhcPs
name, con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details GhcPs
args }
             -> ([LIdP GhcPs
name], [LFieldOcc GhcPs]
flds)
             where
                flds :: [LFieldOcc GhcPs]
flds = HsConDeclH98Details GhcPs -> [LFieldOcc GhcPs]
get_flds_h98 HsConDeclH98Details GhcPs
args

    get_flds_h98 :: HsConDeclH98Details GhcPs
                 -> [LFieldOcc GhcPs]
    get_flds_h98 :: HsConDeclH98Details GhcPs -> [LFieldOcc GhcPs]
get_flds_h98 (RecCon XRec GhcPs [LConDeclField GhcPs]
flds) = Located [LConDeclField GhcPs] -> [LFieldOcc GhcPs]
get_flds (LocatedAn AnnList [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> Located [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall a e. LocatedAn a e -> Located e
reLoc XRec GhcPs [LConDeclField GhcPs]
LocatedAn AnnList [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds)
    get_flds_h98 HsConDeclH98Details GhcPs
_ = []

    get_flds_gadt :: HsConDeclGADTDetails GhcPs
                  -> [LFieldOcc GhcPs]
#if MIN_VERSION_ghc(9,9,0)
    get_flds_gadt (RecConGADT _ flds) = get_flds (reLoc flds)
#elif MIN_VERSION_ghc(9,3,0)
    get_flds_gadt :: HsConDeclGADTDetails GhcPs -> [LFieldOcc GhcPs]
get_flds_gadt (RecConGADT XRec GhcPs [LConDeclField GhcPs]
flds LHsUniToken "->" "\8594" GhcPs
_) = Located [LConDeclField GhcPs] -> [LFieldOcc GhcPs]
get_flds (LocatedAn AnnList [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> Located [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall a e. LocatedAn a e -> Located e
reLoc XRec GhcPs [LConDeclField GhcPs]
LocatedAn AnnList [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds)
#else
    get_flds_gadt (RecConGADT flds) = get_flds (reLoc flds)
#endif
    get_flds_gadt HsConDeclGADTDetails GhcPs
_ = []

    get_flds :: Located [LConDeclField GhcPs]
             -> [LFieldOcc GhcPs]
    get_flds :: Located [LConDeclField GhcPs] -> [LFieldOcc GhcPs]
get_flds Located [LConDeclField GhcPs]
flds = (GenLocated SrcSpanAnnA (ConDeclField GhcPs)
 -> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)])
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ConDeclField GhcPs -> [LFieldOcc GhcPs]
ConDeclField GhcPs
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names (ConDeclField GhcPs
 -> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)])
-> (GenLocated SrcSpanAnnA (ConDeclField GhcPs)
    -> ConDeclField GhcPs)
-> GenLocated SrcSpanAnnA (ConDeclField GhcPs)
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> ConDeclField GhcPs
forall l e. GenLocated l e -> e
unLoc) (Located [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall l e. GenLocated l e -> e
unLoc Located [LConDeclField GhcPs]
Located [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
flds)