{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
#include "ghc-api-version.h"

module Development.IDE.LSP.Outline
  ( setHandlersOutline
    -- * For haskell-language-server

  , moduleOutline
  )
where

import qualified Language.Haskell.LSP.Core     as LSP
import           Language.Haskell.LSP.Messages
import           Language.Haskell.LSP.Types
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      ( realSrcSpanToRange )
import           Development.IDE.LSP.Server
import           Development.IDE.Types.Location
import           Outputable                     ( Outputable
                                                , ppr
                                                , showSDocUnsafe
                                                )

setHandlersOutline :: PartialHandlers c
setHandlersOutline :: PartialHandlers c
setHandlersOutline = (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c)
-> (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall a b. (a -> b) -> a -> b
$ \WithMessage {(LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
 HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
   (Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
    HasTracing req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState
       -> req
       -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
   -> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
   (Show m, Show req, HasTracing req) =>
   Maybe (Handler (NotificationMessage m req))
   -> (LspFuncs c -> IdeState -> req -> IO ())
   -> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
   (Show m, Show req, HasTracing req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState -> req -> IO (Either ResponseError resp))
   -> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
 HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x -> Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x
  { documentSymbolHandler :: Maybe (Handler DocumentSymbolRequest)
LSP.documentSymbolHandler = (ResponseMessage DSResult -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> DocumentSymbolParams
    -> IO (Either ResponseError DSResult))
-> Maybe (Handler DocumentSymbolRequest)
forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage DSResult -> FromServerMessage
RspDocumentSymbols LspFuncs c
-> IdeState
-> DocumentSymbolParams
-> IO (Either ResponseError DSResult)
forall c.
LspFuncs c
-> IdeState
-> DocumentSymbolParams
-> IO (Either ResponseError DSResult)
moduleOutline
  }

moduleOutline
  :: LSP.LspFuncs c -> IdeState -> DocumentSymbolParams -> IO (Either ResponseError DSResult)
moduleOutline :: LspFuncs c
-> IdeState
-> DocumentSymbolParams
-> IO (Either ResponseError DSResult)
moduleOutline LspFuncs c
_lsp IdeState
ideState DocumentSymbolParams { $sel:_textDocument:DocumentSymbolParams :: DocumentSymbolParams -> TextDocumentIdentifier
_textDocument = TextDocumentIdentifier Uri
uri }
  = 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 DSResult -> IO (Either ResponseError DSResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError DSResult
 -> IO (Either ResponseError DSResult))
-> Either ResponseError DSResult
-> IO (Either ResponseError DSResult)
forall a b. (a -> b) -> a -> b
$ DSResult -> Either ResponseError DSResult
forall a b. b -> Either a b
Right (DSResult -> Either ResponseError DSResult)
-> DSResult -> Either ResponseError DSResult
forall a b. (a -> b) -> a -> b
$ case Maybe ParsedModule
mb_decls of
        Maybe ParsedModule
Nothing -> List DocumentSymbol -> DSResult
DSDocumentSymbols ([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 (RealSrcSpan RealSrcSpan
l) 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 (Int -> Int -> Position
Position Int
0 Int
0) (Int -> Int -> Position
Position Int
forall a. Bounded a => a
maxBound Int
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 -> DSResult
DSDocumentSymbols ([DocumentSymbol] -> List DocumentSymbol
forall a. [a] -> List a
List [DocumentSymbol]
allSymbols)


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

documentSymbolForDecl :: Located (HsDecl GhcPs) -> Maybe DocumentSymbol
documentSymbolForDecl :: LHsDecl GhcPs -> Maybe DocumentSymbol
documentSymbolForDecl (L (RealSrcSpan RealSrcSpan
l) (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
SkClass
    }
documentSymbolForDecl (L (RealSrcSpan RealSrcSpan
l) (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
SkClass
    , $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 (RealSrcSpan RealSrcSpan
l)  (ClassOpSig XClassOpSig GhcPs
_ Bool
False [GenLocated SrcSpan (IdP GhcPs)]
names LHsSigType GhcPs
_) <- [LSig GhcPs]
tcdSigs
        , L (RealSrcSpan RealSrcSpan
l') RdrName
n                            <- [GenLocated SrcSpan (IdP GhcPs)]
[GenLocated SrcSpan RdrName]
names
        ]
    }
documentSymbolForDecl (L (RealSrcSpan RealSrcSpan
l) (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'
            , $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
getConArgs ConDecl GhcPs
x)
            }
        | L (RealSrcSpan RealSrcSpan
l ) ConDecl GhcPs
x <- [LConDecl GhcPs]
dd_cons
        , L (RealSrcSpan RealSrcSpan
l') RdrName
n <- ConDecl GhcPs -> [GenLocated SrcSpan (IdP GhcPs)]
forall (p :: Pass).
ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))]
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 (RealSrcSpan RealSrcSpan
l) 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
documentSymbolForDecl (L (RealSrcSpan RealSrcSpan
l) (TyClD XTyClD GhcPs
_ SynDecl { tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = L (RealSrcSpan RealSrcSpan
l') 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 (RealSrcSpan RealSrcSpan
l) (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
                                                 }
documentSymbolForDecl (L (RealSrcSpan RealSrcSpan
l) (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 } } }))
  = 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 (RealSrcSpan RealSrcSpan
l) (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 } } }))
  = 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 (RealSrcSpan RealSrcSpan
l) (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 (RealSrcSpan RealSrcSpan
l) (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 (RealSrcSpan RealSrcSpan
l) (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 (RealSrcSpan RealSrcSpan
l) (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 RealSrcSpan
forall a. Data a => a
empty :: DocumentSymbol)
          { $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)
          , $sel:_range:DocumentSymbol :: Range
_range = Range
importRange
          , $sel:_selectionRange:DocumentSymbol :: Range
_selectionRange = Range
importRange
          }

documentSymbolForImport :: Located (ImportDecl GhcPs) -> Maybe DocumentSymbol
documentSymbolForImport :: LImportDecl GhcPs -> Maybe DocumentSymbol
documentSymbolForImport (L (RealSrcSpan RealSrcSpan
l) 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_GHC_API_VERSION(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 Bool
-> Range
-> Range
-> Maybe (List DocumentSymbol)
-> DocumentSymbol
DocumentSymbol { Maybe Bool
Maybe Text
Maybe (List DocumentSymbol)
Text
SymbolKind
Range
forall a. Maybe a
$sel:_deprecated:DocumentSymbol :: Maybe Bool
_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

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