{-# LANGUAGE CPP                   #-}

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

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

import           Control.Monad.IO.Class
import           Data.Functor
import           Data.Generics
import           Data.Maybe
import           Data.Text                      (Text, pack)
import qualified Data.Text                      as T
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           Language.LSP.Server            (LspM)
import           Language.LSP.Types             (DocumentSymbol (..),
                                                 DocumentSymbolParams (DocumentSymbolParams, _textDocument),
                                                 List (..), ResponseError,
                                                 SymbolInformation,
                                                 SymbolKind (SkConstructor, SkField, SkFile, SkFunction, SkInterface, SkMethod, SkModule, SkObject, SkStruct, SkTypeParameter, SkUnknown),
                                                 TextDocumentIdentifier (TextDocumentIdentifier),
                                                 type (|?) (InL), uriToFilePath)
#if MIN_VERSION_ghc(9,2,0)
import Data.List.NonEmpty (nonEmpty, toList)
#endif

moduleOutline
  :: IdeState -> DocumentSymbolParams -> LspM c (Either ResponseError (List DocumentSymbol |? List SymbolInformation))
moduleOutline :: IdeState
-> DocumentSymbolParams
-> LspM
     c
     (Either
        ResponseError (List DocumentSymbol |? List SymbolInformation))
moduleOutline IdeState
ideState DocumentSymbolParams{ $sel:_textDocument:DocumentSymbolParams :: DocumentSymbolParams -> TextDocumentIdentifier
_textDocument = TextDocumentIdentifier Uri
uri }
  = IO
  (Either
     ResponseError (List DocumentSymbol |? List SymbolInformation))
-> LspM
     c
     (Either
        ResponseError (List DocumentSymbol |? List SymbolInformation))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Either
      ResponseError (List DocumentSymbol |? List SymbolInformation))
 -> LspM
      c
      (Either
         ResponseError (List DocumentSymbol |? List SymbolInformation)))
-> IO
     (Either
        ResponseError (List DocumentSymbol |? List SymbolInformation))
-> LspM
     c
     (Either
        ResponseError (List DocumentSymbol |? List SymbolInformation))
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 (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)
      Either
  ResponseError (List DocumentSymbol |? List SymbolInformation)
-> IO
     (Either
        ResponseError (List DocumentSymbol |? List SymbolInformation))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   ResponseError (List DocumentSymbol |? List SymbolInformation)
 -> IO
      (Either
         ResponseError (List DocumentSymbol |? List SymbolInformation)))
-> Either
     ResponseError (List DocumentSymbol |? List SymbolInformation)
-> IO
     (Either
        ResponseError (List DocumentSymbol |? List SymbolInformation))
forall a b. (a -> b) -> a -> b
$ (List DocumentSymbol |? List SymbolInformation)
-> Either
     ResponseError (List DocumentSymbol |? List SymbolInformation)
forall a b. b -> Either a b
Right ((List DocumentSymbol |? List SymbolInformation)
 -> Either
      ResponseError (List DocumentSymbol |? List SymbolInformation))
-> (List DocumentSymbol |? List SymbolInformation)
-> Either
     ResponseError (List DocumentSymbol |? List SymbolInformation)
forall a b. (a -> b) -> a -> b
$ case Maybe ParsedModule
mb_decls of
        Maybe ParsedModule
Nothing -> List DocumentSymbol
-> List DocumentSymbol |? List SymbolInformation
forall a b. a -> a |? b
InL ([DocumentSymbol] -> List DocumentSymbol
forall a. [a] -> List a
List [])
        Just ParsedModule { pm_parsed_source :: ParsedModule -> ParsedSource
pm_parsed_source = L SrcSpan
_ltop HsModule { Maybe (Located ModuleName)
hsmodName :: forall pass. HsModule pass -> Maybe (Located ModuleName)
hsmodName :: Maybe (Located ModuleName)
hsmodName, [LHsDecl GhcPs]
hsmodDecls :: forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls, [LImportDecl GhcPs]
hsmodImports :: forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports :: [LImportDecl GhcPs]
hsmodImports } }
          -> let
               declSymbols :: [DocumentSymbol]
declSymbols  = (LHsDecl GhcPs -> Maybe DocumentSymbol)
-> [LHsDecl GhcPs] -> [DocumentSymbol]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LHsDecl GhcPs -> Maybe DocumentSymbol
documentSymbolForDecl [LHsDecl GhcPs]
hsmodDecls
               moduleSymbol :: Maybe DocumentSymbol
moduleSymbol = Maybe (Located ModuleName)
hsmodName Maybe (Located ModuleName)
-> (Located ModuleName -> Maybe DocumentSymbol)
-> Maybe DocumentSymbol
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                 (L (SrcSpan -> SrcSpan
forall a. a -> a
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)
                     { $sel:_name:DocumentSymbol :: Text
_name  = ModuleName -> Text
forall a. Outputable a => a -> Text
pprText ModuleName
m
                     , $sel:_kind:DocumentSymbol :: SymbolKind
_kind  = SymbolKind
SkFile
                     , $sel:_range:DocumentSymbol :: Range
_range = Position -> Position -> Range
Range (UInt -> UInt -> Position
Position UInt
0 UInt
0) (UInt -> UInt -> Position
Position UInt
forall a. Bounded a => a
maxBound UInt
0) -- _ltop is 0 0 0 0
                     }
                 Located 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 (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
                    ((LImportDecl GhcPs -> Maybe DocumentSymbol)
-> [LImportDecl GhcPs] -> [DocumentSymbol]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LImportDecl GhcPs -> Maybe DocumentSymbol
documentSymbolForImport [LImportDecl 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 { $sel:_children:DocumentSymbol :: Maybe (List DocumentSymbol)
_children = List DocumentSymbol -> Maybe (List DocumentSymbol)
forall a. a -> Maybe a
Just ([DocumentSymbol] -> List DocumentSymbol
forall a. [a] -> List a
List ([DocumentSymbol]
importSymbols [DocumentSymbol] -> [DocumentSymbol] -> [DocumentSymbol]
forall a. Semigroup a => a -> a -> a
<> [DocumentSymbol]
declSymbols))
                       }
                   ]
             in
               List DocumentSymbol
-> List DocumentSymbol |? List SymbolInformation
forall a b. a -> a |? b
InL ([DocumentSymbol] -> List DocumentSymbol
forall a. [a] -> List a
List [DocumentSymbol]
allSymbols)


    Maybe FilePath
Nothing -> Either
  ResponseError (List DocumentSymbol |? List SymbolInformation)
-> IO
     (Either
        ResponseError (List DocumentSymbol |? List SymbolInformation))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   ResponseError (List DocumentSymbol |? List SymbolInformation)
 -> IO
      (Either
         ResponseError (List DocumentSymbol |? List SymbolInformation)))
-> Either
     ResponseError (List DocumentSymbol |? List SymbolInformation)
-> IO
     (Either
        ResponseError (List DocumentSymbol |? List SymbolInformation))
forall a b. (a -> b) -> a -> b
$ (List DocumentSymbol |? List SymbolInformation)
-> Either
     ResponseError (List DocumentSymbol |? List SymbolInformation)
forall a b. b -> Either a b
Right ((List DocumentSymbol |? List SymbolInformation)
 -> Either
      ResponseError (List DocumentSymbol |? List SymbolInformation))
-> (List DocumentSymbol |? List SymbolInformation)
-> Either
     ResponseError (List DocumentSymbol |? List SymbolInformation)
forall a b. (a -> b) -> a -> b
$ List DocumentSymbol
-> List DocumentSymbol |? List SymbolInformation
forall a b. a -> a |? b
InL ([DocumentSymbol] -> List DocumentSymbol
forall a. [a] -> List a
List [])

documentSymbolForDecl :: LHsDecl GhcPs -> Maybe DocumentSymbol
documentSymbolForDecl :: LHsDecl GhcPs -> Maybe DocumentSymbol
documentSymbolForDecl (L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (TyClD XTyClD GhcPs
_ FamDecl { tcdFam :: forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam = FamilyDecl { fdLName :: forall pass. FamilyDecl pass -> Located (IdP pass)
fdLName = L SrcSpan
_ IdP GhcPs
n, FamilyInfo GhcPs
fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo :: FamilyInfo GhcPs
fdInfo, LHsQTyVars GhcPs
fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdTyVars :: LHsQTyVars GhcPs
fdTyVars } }))
  = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
    { $sel:_name:DocumentSymbol :: Text
_name   = RdrName -> Text
showRdrName IdP GhcPs
RdrName
n
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (case LHsQTyVars GhcPs -> Text
forall a. Outputable a => a -> Text
pprText LHsQTyVars GhcPs
fdTyVars of
                       Text
"" -> Text
""
                       Text
t  -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
                     )
    , $sel:_detail:DocumentSymbol :: Maybe Text
_detail = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ FamilyInfo GhcPs -> Text
forall a. Outputable a => a -> Text
pprText FamilyInfo GhcPs
fdInfo
    , $sel:_kind:DocumentSymbol :: SymbolKind
_kind   = SymbolKind
SkFunction
    }
documentSymbolForDecl (L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (TyClD XTyClD GhcPs
_ ClassDecl { tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = L SrcSpan
_ IdP GhcPs
name, [LSig GhcPs]
tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs :: [LSig GhcPs]
tcdSigs, LHsQTyVars GhcPs
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars :: LHsQTyVars GhcPs
tcdTyVars }))
  = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
    { $sel:_name:DocumentSymbol :: Text
_name     = RdrName -> Text
showRdrName IdP GhcPs
RdrName
name
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (case LHsQTyVars GhcPs -> Text
forall a. Outputable a => a -> Text
pprText LHsQTyVars GhcPs
tcdTyVars of
                         Text
"" -> Text
""
                         Text
t  -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
                       )
    , $sel:_kind:DocumentSymbol :: SymbolKind
_kind     = SymbolKind
SkInterface
    , $sel:_detail:DocumentSymbol :: Maybe Text
_detail   = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"class"
    , $sel:_children:DocumentSymbol :: Maybe (List DocumentSymbol)
_children =
      List DocumentSymbol -> Maybe (List DocumentSymbol)
forall a. a -> Maybe a
Just (List DocumentSymbol -> Maybe (List DocumentSymbol))
-> List DocumentSymbol -> Maybe (List DocumentSymbol)
forall a b. (a -> b) -> a -> b
$ [DocumentSymbol] -> List DocumentSymbol
forall a. [a] -> List a
List
        [ (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
            { $sel:_name:DocumentSymbol :: Text
_name           = RdrName -> Text
showRdrName RdrName
n
            , $sel:_kind:DocumentSymbol :: SymbolKind
_kind           = SymbolKind
SkMethod
            , $sel:_selectionRange:DocumentSymbol :: Range
_selectionRange = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
l'
            }
        | L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_))  (ClassOpSig XClassOpSig GhcPs
_ Bool
False [GenLocated SrcSpan (IdP GhcPs)]
names LHsSigType GhcPs
_) <- [LSig GhcPs]
tcdSigs
        , L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l' Maybe BufSpan
_)) RdrName
n                            <- [GenLocated SrcSpan (IdP GhcPs)]
[GenLocated SrcSpan RdrName]
names
        ]
    }
documentSymbolForDecl (L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (TyClD XTyClD GhcPs
_ DataDecl { tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = L SrcSpan
_ IdP GhcPs
name, tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn { [LConDecl GhcPs]
dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons :: [LConDecl GhcPs]
dd_cons } }))
  = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
    { $sel:_name:DocumentSymbol :: Text
_name     = RdrName -> Text
showRdrName IdP GhcPs
RdrName
name
    , $sel:_kind:DocumentSymbol :: SymbolKind
_kind     = SymbolKind
SkStruct
    , $sel:_children:DocumentSymbol :: Maybe (List DocumentSymbol)
_children =
      List DocumentSymbol -> Maybe (List DocumentSymbol)
forall a. a -> Maybe a
Just (List DocumentSymbol -> Maybe (List DocumentSymbol))
-> List DocumentSymbol -> Maybe (List DocumentSymbol)
forall a b. (a -> b) -> a -> b
$ [DocumentSymbol] -> List DocumentSymbol
forall a. [a] -> List a
List
        [ (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
            { $sel:_name:DocumentSymbol :: Text
_name           = RdrName -> Text
showRdrName RdrName
n
            , $sel:_kind:DocumentSymbol :: SymbolKind
_kind           = SymbolKind
SkConstructor
            , $sel:_selectionRange:DocumentSymbol :: Range
_selectionRange = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
l'
#if MIN_VERSION_ghc(9,2,0)
            , _children       = List . toList <$> nonEmpty childs
            }
        | con <- dd_cons
        , let (cs, flds) = hsConDeclsBinders con
        , let childs = mapMaybe cvtFld flds
        , L (locA -> RealSrcSpan l' _) n <- cs
        , let l = case con of
                L (locA -> RealSrcSpan l _) _ -> l
                _ -> l'
        ]
    }
  where
    cvtFld :: LFieldOcc GhcPs -> Maybe DocumentSymbol
    cvtFld (L (RealSrcSpan l _) n) = Just $ (defDocumentSymbol l :: DocumentSymbol)
                { _name = showRdrName (unLoc (rdrNameFieldOcc n))
                , _kind = SkField
                }
    cvtFld _  = Nothing
#else
           , $sel:_children:DocumentSymbol :: Maybe (List DocumentSymbol)
_children       = HsConDetails
  (LBangType GhcPs)
  (GenLocated SrcSpan [GenLocated SrcSpan (ConDeclField GhcPs)])
-> Maybe (List DocumentSymbol)
forall arg l l pass.
HsConDetails arg (GenLocated l [GenLocated l (ConDeclField pass)])
-> Maybe (List DocumentSymbol)
conArgRecordFields (ConDecl GhcPs
-> HsConDetails
     (LBangType GhcPs)
     (GenLocated SrcSpan [GenLocated SrcSpan (ConDeclField GhcPs)])
forall pass. ConDecl pass -> HsConDeclDetails pass
con_args ConDecl GhcPs
x)
            }
        | L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_ )) ConDecl GhcPs
x <- [LConDecl GhcPs]
dd_cons
        , L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l' Maybe BufSpan
_)) RdrName
n <- ConDecl GhcPs -> [GenLocated SrcSpan (IdP GhcPs)]
getConNames' ConDecl GhcPs
x
        ]
    }
  where
    -- | Extract the record fields of a constructor
    conArgRecordFields :: HsConDetails arg (GenLocated l [GenLocated l (ConDeclField pass)])
-> Maybe (List DocumentSymbol)
conArgRecordFields (RecCon (L l
_ [GenLocated l (ConDeclField pass)]
lcdfs)) = List DocumentSymbol -> Maybe (List DocumentSymbol)
forall a. a -> Maybe a
Just (List DocumentSymbol -> Maybe (List DocumentSymbol))
-> List DocumentSymbol -> Maybe (List DocumentSymbol)
forall a b. (a -> b) -> a -> b
$ [DocumentSymbol] -> List DocumentSymbol
forall a. [a] -> List a
List
      [ (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
          { $sel:_name:DocumentSymbol :: Text
_name = RdrName -> Text
showRdrName RdrName
n
          , $sel:_kind:DocumentSymbol :: SymbolKind
_kind = SymbolKind
SkField
          }
      | L l
_ ConDeclField pass
cdf <- [GenLocated l (ConDeclField pass)]
lcdfs
      , L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) RdrName
n <- FieldOcc pass -> GenLocated SrcSpan RdrName
forall pass. FieldOcc pass -> GenLocated SrcSpan RdrName
rdrNameFieldOcc (FieldOcc pass -> GenLocated SrcSpan RdrName)
-> (LFieldOcc pass -> FieldOcc pass)
-> LFieldOcc pass
-> GenLocated SrcSpan RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LFieldOcc pass -> FieldOcc pass
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LFieldOcc pass -> GenLocated SrcSpan RdrName)
-> [LFieldOcc pass] -> [GenLocated SrcSpan RdrName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConDeclField pass -> [LFieldOcc pass]
forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names ConDeclField pass
cdf
      ]
    conArgRecordFields HsConDetails arg (GenLocated l [GenLocated l (ConDeclField pass)])
_ = Maybe (List DocumentSymbol)
forall a. Maybe a
Nothing
#endif
documentSymbolForDecl (L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (TyClD XTyClD GhcPs
_ SynDecl { tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l' Maybe BufSpan
_)) IdP GhcPs
n })) = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just
  (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol) { $sel:_name:DocumentSymbol :: Text
_name           = RdrName -> Text
showRdrName IdP GhcPs
RdrName
n
                                          , $sel:_kind:DocumentSymbol :: SymbolKind
_kind           = SymbolKind
SkTypeParameter
                                          , $sel:_selectionRange:DocumentSymbol :: Range
_selectionRange = RealSrcSpan -> Range
realSrcSpanToRange RealSrcSpan
l'
                                          }
documentSymbolForDecl (L (SrcSpan -> SrcSpan
forall a. a -> a
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 :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty :: LHsSigType GhcPs
cid_poly_ty } }))
  = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol) { $sel:_name:DocumentSymbol :: Text
_name = LHsSigType GhcPs -> Text
forall a. Outputable a => a -> Text
pprText LHsSigType GhcPs
cid_poly_ty
                                                 , $sel:_kind:DocumentSymbol :: SymbolKind
_kind = SymbolKind
SkInterface
                                                 }
#if MIN_VERSION_ghc(9,2,0)
documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl FamEqn { feqn_tycon, feqn_pats } }))
#else
documentSymbolForDecl (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) (InstD XInstD GhcPs
_ DataFamInstD { dfid_inst :: forall pass. InstDecl pass -> DataFamInstDecl pass
dfid_inst = DataFamInstDecl HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn { GenLocated SrcSpan (IdP GhcPs)
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon :: GenLocated SrcSpan (IdP GhcPs)
feqn_tycon, HsTyPats GhcPs
feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats :: HsTyPats GhcPs
feqn_pats } } }))
#endif
  = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
    { $sel:_name:DocumentSymbol :: Text
_name = RdrName -> Text
showRdrName (GenLocated SrcSpan RdrName
-> SrcSpanLess (GenLocated SrcSpan RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc GenLocated SrcSpan (IdP GhcPs)
GenLocated SrcSpan RdrName
feqn_tycon) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords
                ((LHsTypeArg GhcPs -> Text) -> HsTyPats GhcPs -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map LHsTypeArg GhcPs -> Text
forall a. Outputable a => a -> Text
pprText HsTyPats GhcPs
feqn_pats)
    , $sel:_kind:DocumentSymbol :: SymbolKind
_kind = SymbolKind
SkInterface
    }
#if MIN_VERSION_ghc(9,2,0)
documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl _ FamEqn { feqn_tycon, feqn_pats } }))
#else
documentSymbolForDecl (L (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) (InstD XInstD GhcPs
_ TyFamInstD { tfid_inst :: forall pass. InstDecl pass -> TyFamInstDecl pass
tfid_inst = TyFamInstDecl HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn { GenLocated SrcSpan (IdP GhcPs)
feqn_tycon :: GenLocated SrcSpan (IdP GhcPs)
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon, HsTyPats GhcPs
feqn_pats :: HsTyPats GhcPs
feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats } } }))
#endif
  = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
    { $sel:_name:DocumentSymbol :: Text
_name = RdrName -> Text
showRdrName (GenLocated SrcSpan RdrName
-> SrcSpanLess (GenLocated SrcSpan RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc GenLocated SrcSpan (IdP GhcPs)
GenLocated SrcSpan RdrName
feqn_tycon) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords
                ((LHsTypeArg GhcPs -> Text) -> HsTyPats GhcPs -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map LHsTypeArg GhcPs -> Text
forall a. Outputable a => a -> Text
pprText HsTyPats GhcPs
feqn_pats)
    , $sel:_kind:DocumentSymbol :: SymbolKind
_kind = SymbolKind
SkInterface
    }
documentSymbolForDecl (L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (DerivD XDerivD GhcPs
_ DerivDecl { LHsSigWcType GhcPs
deriv_type :: forall pass. DerivDecl pass -> LHsSigWcType pass
deriv_type :: LHsSigWcType GhcPs
deriv_type })) =
  LHsSigWcType GhcPs -> Maybe (LBangType GhcPs)
forall x y. (Data x, Typeable y) => x -> Maybe y
gfindtype LHsSigWcType GhcPs
deriv_type Maybe (LBangType GhcPs)
-> (LBangType 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) { $sel:_name:DocumentSymbol :: Text
_name = HsType GhcPs -> Text
forall a. Outputable a => a -> Text
pprText @(HsType GhcPs)
                                              HsType GhcPs
name
                                            , $sel:_kind:DocumentSymbol :: SymbolKind
_kind = SymbolKind
SkInterface
                                            }
documentSymbolForDecl (L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (ValD XValD GhcPs
_ FunBind{fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id = L SrcSpan
_ IdP GhcPs
name})) = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just
    (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
      { $sel:_name:DocumentSymbol :: Text
_name   = RdrName -> Text
showRdrName IdP GhcPs
RdrName
name
      , $sel:_kind:DocumentSymbol :: SymbolKind
_kind   = SymbolKind
SkFunction
      }
documentSymbolForDecl (L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) (ValD XValD GhcPs
_ PatBind{LPat GhcPs
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs :: LPat GhcPs
pat_lhs})) = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just
    (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
      { $sel:_name:DocumentSymbol :: Text
_name   = Located (Pat GhcPs) -> Text
forall a. Outputable a => a -> Text
pprText LPat GhcPs
Located (Pat GhcPs)
pat_lhs
      , $sel:_kind:DocumentSymbol :: SymbolKind
_kind   = SymbolKind
SkFunction
      }

documentSymbolForDecl (L (SrcSpan -> SrcSpan
forall a. a -> a
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)
    { $sel:_name:DocumentSymbol :: Text
_name   = case ForeignDecl GhcPs
x of
                  ForeignImport{} -> Text
name
                  ForeignExport{} -> Text
name
                  XForeignDecl{}  -> Text
"?"
    , $sel:_kind:DocumentSymbol :: SymbolKind
_kind   = SymbolKind
SkObject
    , $sel:_detail:DocumentSymbol :: Maybe Text
_detail = case ForeignDecl GhcPs
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"
                  XForeignDecl{}  -> Maybe Text
forall a. Maybe a
Nothing
    }
  where name :: Text
name = RdrName -> Text
showRdrName (RdrName -> Text) -> RdrName -> Text
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan RdrName
-> SrcSpanLess (GenLocated SrcSpan RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (GenLocated SrcSpan RdrName
 -> SrcSpanLess (GenLocated SrcSpan RdrName))
-> GenLocated SrcSpan RdrName
-> SrcSpanLess (GenLocated SrcSpan RdrName)
forall a b. (a -> b) -> a -> b
$ ForeignDecl GhcPs -> GenLocated SrcSpan (IdP GhcPs)
forall pass. ForeignDecl pass -> Located (IdP 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 (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 (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 :: DocumentSymbol -> Range) [DocumentSymbol]
importSymbols
    in
      DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just (RealSrcSpan -> DocumentSymbol
defDocumentSymbol (NormalizedFilePath -> Range -> RealSrcSpan
rangeToRealSrcSpan NormalizedFilePath
"" Range
importRange))
          { $sel:_name:DocumentSymbol :: Text
_name = Text
"imports"
          , $sel:_kind:DocumentSymbol :: SymbolKind
_kind = SymbolKind
SkModule
          , $sel:_children:DocumentSymbol :: Maybe (List DocumentSymbol)
_children = List DocumentSymbol -> Maybe (List DocumentSymbol)
forall a. a -> Maybe a
Just ([DocumentSymbol] -> List DocumentSymbol
forall a. [a] -> List a
List [DocumentSymbol]
importSymbols)
          }

documentSymbolForImport :: LImportDecl GhcPs -> Maybe DocumentSymbol
documentSymbolForImport :: LImportDecl GhcPs -> Maybe DocumentSymbol
documentSymbolForImport (L (SrcSpan -> SrcSpan
forall a. a -> a
locA -> (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_)) ImportDecl { Located ModuleName
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclName :: Located ModuleName
ideclName, ImportDeclQualifiedStyle
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified :: ImportDeclQualifiedStyle
ideclQualified }) = DocumentSymbol -> Maybe DocumentSymbol
forall a. a -> Maybe a
Just
  (RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l :: DocumentSymbol)
    { $sel:_name:DocumentSymbol :: Text
_name   = Text
"import " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Located ModuleName -> Text
forall a. Outputable a => a -> Text
pprText Located ModuleName
ideclName
    , $sel:_kind:DocumentSymbol :: SymbolKind
_kind   = SymbolKind
SkModule
#if MIN_VERSION_ghc(8,10,0)
    , $sel:_detail:DocumentSymbol :: Maybe Text
_detail = case ImportDeclQualifiedStyle
ideclQualified of { ImportDeclQualifiedStyle
NotQualified -> Maybe Text
forall a. Maybe a
Nothing; ImportDeclQualifiedStyle
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"qualified" }
#else
    , _detail = if ideclQualified then Just "qualified" else Nothing
#endif
    }
documentSymbolForImport LImportDecl GhcPs
_ = Maybe DocumentSymbol
forall a. Maybe a
Nothing

defDocumentSymbol :: RealSrcSpan -> DocumentSymbol
defDocumentSymbol :: RealSrcSpan -> DocumentSymbol
defDocumentSymbol RealSrcSpan
l = DocumentSymbol :: Text
-> Maybe Text
-> SymbolKind
-> Maybe (List SymbolTag)
-> Maybe Bool
-> Range
-> Range
-> Maybe (List DocumentSymbol)
-> DocumentSymbol
DocumentSymbol { Maybe Bool
Maybe Text
Maybe (List DocumentSymbol)
Maybe (List SymbolTag)
Text
SymbolKind
Range
forall a. Maybe a
$sel:_tags:DocumentSymbol :: Maybe (List SymbolTag)
$sel:_deprecated:DocumentSymbol :: Maybe Bool
_tags :: forall a. Maybe a
_children :: forall a. Maybe a
_selectionRange :: Range
_range :: Range
_kind :: SymbolKind
_name :: Text
_deprecated :: forall a. Maybe a
_detail :: forall a. Maybe a
$sel:_selectionRange:DocumentSymbol :: Range
$sel:_detail:DocumentSymbol :: Maybe Text
$sel:_children:DocumentSymbol :: Maybe (List DocumentSymbol)
$sel:_range:DocumentSymbol :: Range
$sel:_kind:DocumentSymbol :: SymbolKind
$sel:_name:DocumentSymbol :: Text
.. } 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
""
  _kind :: SymbolKind
_kind           = Scientific -> SymbolKind
SkUnknown Scientific
0
  _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

showRdrName :: RdrName -> Text
showRdrName :: RdrName -> Text
showRdrName = RdrName -> Text
forall a. Outputable a => a -> Text
pprText

pprText :: Outputable a => a -> Text
pprText :: a -> Text
pprText = FilePath -> Text
pack (FilePath -> Text) -> (a -> FilePath) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> FilePath
showSDocUnsafe (SDoc -> FilePath) -> (a -> SDoc) -> a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SDoc
forall a. Outputable a => a -> SDoc
ppr

-- the version of getConNames for ghc9 is restricted to only the renaming phase
#if !MIN_VERSION_ghc(9,2,0)
getConNames' :: ConDecl GhcPs -> [Located (IdP GhcPs)]
getConNames' :: ConDecl GhcPs -> [GenLocated SrcSpan (IdP GhcPs)]
getConNames' ConDeclH98  {con_name :: forall pass. ConDecl pass -> Located (IdP pass)
con_name  = GenLocated SrcSpan (IdP GhcPs)
name}  = [GenLocated SrcSpan (IdP GhcPs)
name]
getConNames' ConDeclGADT {con_names :: forall pass. ConDecl pass -> [Located (IdP pass)]
con_names = [GenLocated SrcSpan (IdP GhcPs)]
names} = [GenLocated SrcSpan (IdP GhcPs)]
names
#if !MIN_VERSION_ghc(8,10,0)
getConNames' (XConDecl NoExt)                = []
#elif !MIN_VERSION_ghc(9,0,0)
getConNames' (XConDecl XXConDecl GhcPs
x)                    = NoExtCon -> [GenLocated SrcSpan RdrName]
forall a. NoExtCon -> a
noExtCon NoExtCon
XXConDecl GhcPs
x
#endif
#else
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 cons
  = go cons
  where
    go :: LConDecl GhcPs
       -> ([LIdP GhcPs], [LFieldOcc GhcPs])
    go 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 unLoc r of
           -- remove only the first occurrence of any seen field in order to
           -- avoid circumventing detection of duplicate fields (#9156)
           ConDeclGADT { con_names = names, con_g_args = args }
             -> (names, flds)
             where
                flds = get_flds_gadt args

           ConDeclH98 { con_name = name, con_args = args }
             -> ([name], flds)
             where
                flds = get_flds_h98 args

    get_flds_h98 :: HsConDeclH98Details GhcPs
                 -> [LFieldOcc GhcPs]
    get_flds_h98 (RecCon flds) = get_flds (reLoc flds)
    get_flds_h98 _ = []

    get_flds_gadt :: HsConDeclGADTDetails GhcPs
                  -> ([LFieldOcc GhcPs])
    get_flds_gadt (RecConGADT flds) = get_flds (reLoc flds)
    get_flds_gadt _ = []

    get_flds :: Located [LConDeclField GhcPs]
             -> ([LFieldOcc GhcPs])
    get_flds flds = concatMap (cd_fld_names . unLoc) (unLoc flds)
#endif