module Unison.LSP.DocumentSymbols
  ( documentSymbolsHandler,
  )
where

import Control.Lens hiding (List)
import Language.LSP.Protocol.Lens hiding (error)
import Language.LSP.Protocol.Message qualified as Msg
import Language.LSP.Protocol.Types
import Unison.LSP.FileAnalysis
import Unison.LSP.FileAnalysis qualified as FileAnalysis
import Unison.LSP.Types
import Unison.Prelude
import Unison.PrettyPrintEnv (PrettyPrintEnv)
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Syntax.Name qualified as Name
import Unison.Syntax.TypePrinter qualified as TypePrinter
import Unison.Util.Pretty qualified as Pretty

-- | Go to Definition handler
documentSymbolsHandler :: Msg.TRequestMessage 'Msg.Method_TextDocumentDocumentSymbol -> (Either (Msg.TResponseError m) (Msg.MessageResult 'Msg.Method_TextDocumentDocumentSymbol) -> Lsp ()) -> Lsp ()
documentSymbolsHandler :: forall {f :: MessageDirection} (m :: Method f 'Request).
TRequestMessage 'Method_TextDocumentDocumentSymbol
-> (Either
      (TResponseError m)
      (MessageResult 'Method_TextDocumentDocumentSymbol)
    -> Lsp ())
-> Lsp ()
documentSymbolsHandler TRequestMessage 'Method_TextDocumentDocumentSymbol
m Either
  (TResponseError m)
  (MessageResult 'Method_TextDocumentDocumentSymbol)
-> Lsp ()
respond = do
  Either
  (TResponseError m)
  ([SymbolInformation] |? ([DocumentSymbol] |? Null))
-> Lsp ()
Either
  (TResponseError m)
  (MessageResult 'Method_TextDocumentDocumentSymbol)
-> Lsp ()
respond (Either
   (TResponseError m)
   ([SymbolInformation] |? ([DocumentSymbol] |? Null))
 -> Lsp ())
-> (Maybe [DocumentSymbol]
    -> Either
         (TResponseError m)
         ([SymbolInformation] |? ([DocumentSymbol] |? Null)))
-> Maybe [DocumentSymbol]
-> Lsp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymbolInformation] |? ([DocumentSymbol] |? Null))
-> Either
     (TResponseError m)
     ([SymbolInformation] |? ([DocumentSymbol] |? Null))
forall a b. b -> Either a b
Right (([SymbolInformation] |? ([DocumentSymbol] |? Null))
 -> Either
      (TResponseError m)
      ([SymbolInformation] |? ([DocumentSymbol] |? Null)))
-> (Maybe [DocumentSymbol]
    -> [SymbolInformation] |? ([DocumentSymbol] |? Null))
-> Maybe [DocumentSymbol]
-> Either
     (TResponseError m)
     ([SymbolInformation] |? ([DocumentSymbol] |? Null))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymbolInformation] |? ([DocumentSymbol] |? Null))
-> ([DocumentSymbol]
    -> [SymbolInformation] |? ([DocumentSymbol] |? Null))
-> Maybe [DocumentSymbol]
-> [SymbolInformation] |? ([DocumentSymbol] |? Null)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (([DocumentSymbol] |? Null)
-> [SymbolInformation] |? ([DocumentSymbol] |? Null)
forall a b. b -> a |? b
InR (([DocumentSymbol] |? Null)
 -> [SymbolInformation] |? ([DocumentSymbol] |? Null))
-> ([DocumentSymbol] -> [DocumentSymbol] |? Null)
-> [DocumentSymbol]
-> [SymbolInformation] |? ([DocumentSymbol] |? Null)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DocumentSymbol] -> [DocumentSymbol] |? Null
forall a b. a -> a |? b
InL ([DocumentSymbol]
 -> [SymbolInformation] |? ([DocumentSymbol] |? Null))
-> [DocumentSymbol]
-> [SymbolInformation] |? ([DocumentSymbol] |? Null)
forall a b. (a -> b) -> a -> b
$ []) (([DocumentSymbol] |? Null)
-> [SymbolInformation] |? ([DocumentSymbol] |? Null)
forall a b. b -> a |? b
InR (([DocumentSymbol] |? Null)
 -> [SymbolInformation] |? ([DocumentSymbol] |? Null))
-> ([DocumentSymbol] -> [DocumentSymbol] |? Null)
-> [DocumentSymbol]
-> [SymbolInformation] |? ([DocumentSymbol] |? Null)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DocumentSymbol] -> [DocumentSymbol] |? Null
forall a b. a -> a |? b
InL) (Maybe [DocumentSymbol] -> Lsp ())
-> Lsp (Maybe [DocumentSymbol]) -> Lsp ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MaybeT Lsp [DocumentSymbol] -> Lsp (Maybe [DocumentSymbol])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    let fileUri :: Uri
fileUri = TRequestMessage 'Method_TextDocumentDocumentSymbol
m TRequestMessage 'Method_TextDocumentDocumentSymbol
-> Getting
     Uri (TRequestMessage 'Method_TextDocumentDocumentSymbol) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (DocumentSymbolParams -> Const Uri DocumentSymbolParams)
-> TRequestMessage 'Method_TextDocumentDocumentSymbol
-> Const Uri (TRequestMessage 'Method_TextDocumentDocumentSymbol)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentDocumentSymbol)
  DocumentSymbolParams
params ((DocumentSymbolParams -> Const Uri DocumentSymbolParams)
 -> TRequestMessage 'Method_TextDocumentDocumentSymbol
 -> Const Uri (TRequestMessage 'Method_TextDocumentDocumentSymbol))
-> ((Uri -> Const Uri Uri)
    -> DocumentSymbolParams -> Const Uri DocumentSymbolParams)
-> Getting
     Uri (TRequestMessage 'Method_TextDocumentDocumentSymbol) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> DocumentSymbolParams -> Const Uri DocumentSymbolParams
forall s a. HasTextDocument s a => Lens' s a
Lens' DocumentSymbolParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> DocumentSymbolParams -> Const Uri DocumentSymbolParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> (Uri -> Const Uri Uri)
-> DocumentSymbolParams
-> Const Uri DocumentSymbolParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri
    FileAnalysis {documentSymbols} <- Uri -> MaybeT Lsp FileAnalysis
forall (m :: * -> *). Lspish m => Uri -> MaybeT m FileAnalysis
FileAnalysis.getFileAnalysis Uri
fileUri
    ppe <- PPED.suffixifiedPPE <$> lift (ppedForFile fileUri)
    pure (asLspDocumentSymbols ppe <$> documentSymbols)

asLspDocumentSymbols :: PrettyPrintEnv -> UDocumentSymbol -> DocumentSymbol
asLspDocumentSymbols :: PrettyPrintEnv -> UDocumentSymbol -> DocumentSymbol
asLspDocumentSymbols
  PrettyPrintEnv
ppe
  UDocumentSymbol
    { Name
symbolName :: Name
symbolName :: UDocumentSymbol -> Name
symbolName,
      Maybe (Type Symbol Ann)
symbolSignature :: Maybe (Type Symbol Ann)
symbolSignature :: UDocumentSymbol -> Maybe (Type Symbol Ann)
symbolSignature,
      USymbolKind
symbolKind :: USymbolKind
symbolKind :: UDocumentSymbol -> USymbolKind
symbolKind,
      Range
symbolRange :: Range
symbolRange :: UDocumentSymbol -> Range
symbolRange,
      [UDocumentSymbol]
symbolChildren :: [UDocumentSymbol]
symbolChildren :: UDocumentSymbol -> [UDocumentSymbol]
symbolChildren
    } =
    DocumentSymbol
      { _name :: Text
_name = Name -> Text
Name.toText Name
symbolName,
        _detail :: Maybe Text
_detail = do
          typ <- Maybe (Type Symbol Ann)
symbolSignature
          pure $ ": " <> (TypePrinter.prettyStr typeWidth ppe typ),
        _kind :: SymbolKind
_kind = USymbolKind -> SymbolKind
lspSymbolKind USymbolKind
symbolKind,
        _tags :: Maybe [SymbolTag]
_tags = [SymbolTag] -> Maybe [SymbolTag]
forall a. a -> Maybe a
Just [],
        _deprecated :: Maybe Bool
_deprecated = Maybe Bool
forall a. Maybe a
Nothing,
        _range :: Range
_range = Range
symbolRange,
        _selectionRange :: Range
_selectionRange = Range
symbolRange,
        _children :: Maybe [DocumentSymbol]
_children = if [UDocumentSymbol] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UDocumentSymbol]
symbolChildren then Maybe [DocumentSymbol]
forall a. Maybe a
Nothing else [DocumentSymbol] -> Maybe [DocumentSymbol]
forall a. a -> Maybe a
Just (PrettyPrintEnv -> UDocumentSymbol -> DocumentSymbol
asLspDocumentSymbols PrettyPrintEnv
ppe (UDocumentSymbol -> DocumentSymbol)
-> [UDocumentSymbol] -> [DocumentSymbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UDocumentSymbol]
symbolChildren)
      }
    where
      typeWidth :: Width
typeWidth = Int -> Width
Pretty.Width Int
120
      lspSymbolKind :: USymbolKind -> SymbolKind
lspSymbolKind = \case
        USymbolKind
DataDeclSymbol -> SymbolKind
SymbolKind_Class
        USymbolKind
EffectDeclSymbol -> SymbolKind
SymbolKind_Interface
        USymbolKind
TermSymbol -> SymbolKind
SymbolKind_Function