module Unison.LSP.Hover where

import Control.Lens hiding (List)
import Control.Monad.Reader
import Data.IntervalMap.Lazy qualified as IM
import Data.Text qualified as Text
import Language.LSP.Protocol.Lens
import Language.LSP.Protocol.Message qualified as Msg
import Language.LSP.Protocol.Types
import Unison.ABT qualified as ABT
import Unison.HashQualified qualified as HQ
import Unison.LSP.FileAnalysis (ppedForFile)
import Unison.LSP.FileAnalysis qualified as FileAnalysis
import Unison.LSP.Queries qualified as LSPQ
import Unison.LSP.Types
import Unison.LSP.VFS qualified as VFS
import Unison.LabeledDependency qualified as LD
import Unison.Parser.Ann (Ann)
import Unison.Pattern qualified as Pattern
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Reference qualified as Reference
import Unison.Runtime.IOSource qualified as IOSource
import Unison.Symbol (Symbol)
import Unison.Symbol qualified as Symbol
import Unison.Syntax.DeclPrinter qualified as DeclPrinter
import Unison.Syntax.Name qualified as Name
import Unison.Syntax.TypePrinter qualified as TypePrinter
import Unison.Term qualified as Term
import Unison.Type qualified as Type
import Unison.Util.Pretty qualified as Pretty
import Unison.Var (Var)
import Unison.Var qualified as Var
import UnliftIO qualified

-- | Hover help handler
hoverHandler :: Msg.TRequestMessage 'Msg.Method_TextDocumentHover -> (Either Msg.ResponseError (Msg.MessageResult 'Msg.Method_TextDocumentHover) -> Lsp ()) -> Lsp ()
hoverHandler :: TRequestMessage 'Method_TextDocumentHover
-> (Either ResponseError (MessageResult 'Method_TextDocumentHover)
    -> Lsp ())
-> Lsp ()
hoverHandler TRequestMessage 'Method_TextDocumentHover
m Either ResponseError (MessageResult 'Method_TextDocumentHover)
-> Lsp ()
respond = do
  Either ResponseError (Hover |? Null) -> Lsp ()
Either ResponseError (MessageResult 'Method_TextDocumentHover)
-> Lsp ()
respond (Either ResponseError (Hover |? Null) -> Lsp ())
-> (Maybe Hover -> Either ResponseError (Hover |? Null))
-> Maybe Hover
-> Lsp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hover |? Null) -> Either ResponseError (Hover |? Null)
forall a b. b -> Either a b
Right ((Hover |? Null) -> Either ResponseError (Hover |? Null))
-> (Maybe Hover -> Hover |? Null)
-> Maybe Hover
-> Either ResponseError (Hover |? Null)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hover |? Null)
-> (Hover -> Hover |? Null) -> Maybe Hover -> Hover |? Null
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Null -> Hover |? Null
forall a b. b -> a |? b
InR Null
Null) Hover -> Hover |? Null
forall a b. a -> a |? b
InL (Maybe Hover -> Lsp ()) -> Lsp (Maybe Hover) -> Lsp ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MaybeT Lsp Hover -> Lsp (Maybe Hover)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    let pos :: Position
pos = (TRequestMessage 'Method_TextDocumentHover
m TRequestMessage 'Method_TextDocumentHover
-> Getting
     Position (TRequestMessage 'Method_TextDocumentHover) Position
-> Position
forall s a. s -> Getting a s a -> a
^. (HoverParams -> Const Position HoverParams)
-> TRequestMessage 'Method_TextDocumentHover
-> Const Position (TRequestMessage 'Method_TextDocumentHover)
forall s a. HasParams s a => Lens' s a
Lens' (TRequestMessage 'Method_TextDocumentHover) HoverParams
params ((HoverParams -> Const Position HoverParams)
 -> TRequestMessage 'Method_TextDocumentHover
 -> Const Position (TRequestMessage 'Method_TextDocumentHover))
-> ((Position -> Const Position Position)
    -> HoverParams -> Const Position HoverParams)
-> Getting
     Position (TRequestMessage 'Method_TextDocumentHover) Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const Position Position)
-> HoverParams -> Const Position HoverParams
forall s a. HasPosition s a => Lens' s a
Lens' HoverParams Position
position)
    Text
hoverTxt <- Uri -> Position -> MaybeT Lsp Text
forall (m :: * -> *).
(Lspish m, MonadUnliftIO m) =>
Uri -> Position -> MaybeT m Text
hoverInfo (TRequestMessage 'Method_TextDocumentHover
m TRequestMessage 'Method_TextDocumentHover
-> Getting Uri (TRequestMessage 'Method_TextDocumentHover) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (HoverParams -> Const Uri HoverParams)
-> TRequestMessage 'Method_TextDocumentHover
-> Const Uri (TRequestMessage 'Method_TextDocumentHover)
forall s a. HasParams s a => Lens' s a
Lens' (TRequestMessage 'Method_TextDocumentHover) HoverParams
params ((HoverParams -> Const Uri HoverParams)
 -> TRequestMessage 'Method_TextDocumentHover
 -> Const Uri (TRequestMessage 'Method_TextDocumentHover))
-> ((Uri -> Const Uri Uri) -> HoverParams -> Const Uri HoverParams)
-> Getting Uri (TRequestMessage 'Method_TextDocumentHover) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> HoverParams -> Const Uri HoverParams
forall s a. HasTextDocument s a => Lens' s a
Lens' HoverParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> HoverParams -> Const Uri HoverParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> (Uri -> Const Uri Uri)
-> HoverParams
-> Const Uri HoverParams
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) Position
pos
    Hover -> MaybeT Lsp Hover
forall a. a -> MaybeT Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Hover -> MaybeT Lsp Hover) -> Hover -> MaybeT Lsp Hover
forall a b. (a -> b) -> a -> b
$
      Hover
        { $sel:_contents:Hover :: MarkupContent |? (MarkedString |? [MarkedString])
_contents = MarkupContent -> MarkupContent |? (MarkedString |? [MarkedString])
forall a b. a -> a |? b
InL (MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown Text
hoverTxt),
          $sel:_range:Hover :: Maybe Range
_range = Maybe Range
forall a. Maybe a
Nothing -- TODO add range info
        }

hoverInfo :: forall m. (Lspish m, MonadUnliftIO m) => Uri -> Position -> MaybeT m Text
hoverInfo :: forall (m :: * -> *).
(Lspish m, MonadUnliftIO m) =>
Uri -> Position -> MaybeT m Text
hoverInfo Uri
uri Position
pos =
  (MaybeT m Text
MonadUnliftIO m => MaybeT m Text
hoverInfoForRef MaybeT m Text -> MaybeT m Text -> MaybeT m Text
forall a. MaybeT m a -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MaybeT m Text
hoverInfoForLiteral MaybeT m Text -> MaybeT m Text -> MaybeT m Text
forall a. MaybeT m a -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MaybeT m Text
hoverInfoForLocalVar)
  where
    markdownify :: Text -> Text
    markdownify :: Text -> Text
markdownify Text
rendered = [Text] -> Text
Text.unlines [Text
"``` unison", Text
rendered, Text
"```"]
    prettyWidth :: Pretty.Width
    prettyWidth :: Width
prettyWidth = Width
40
    hoverInfoForRef :: (MonadUnliftIO m) => MaybeT m Text
    hoverInfoForRef :: MonadUnliftIO m => MaybeT m Text
hoverInfoForRef = do
      Text
symAtCursor <- Uri -> Position -> MaybeT m Text
forall (m :: * -> *). Lspish m => Uri -> Position -> MaybeT m Text
VFS.identifierAtPosition Uri
uri Position
pos
      LabeledDependency
ref <- Uri -> Position -> MaybeT m LabeledDependency
forall (m :: * -> *).
Lspish m =>
Uri -> Position -> MaybeT m LabeledDependency
LSPQ.refAtPosition Uri
uri Position
pos
      PrettyPrintEnvDecl
pped <- Uri -> MaybeT m PrettyPrintEnvDecl
forall (m :: * -> *). Lspish m => Uri -> m PrettyPrintEnvDecl
ppedForFile Uri
uri
      let unsuffixifiedPPE :: PrettyPrintEnv
unsuffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped
      let fqn :: HashQualified Name
fqn = case LabeledDependency
ref of
            LD.TypeReference Reference
ref -> PrettyPrintEnv -> Reference -> HashQualified Name
PPE.typeName PrettyPrintEnv
unsuffixifiedPPE Reference
ref
            LD.TermReferent Referent
ref -> PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
unsuffixifiedPPE Referent
ref

      Async (TypecheckedUnisonFile Symbol Ann)
builtinsAsync <- IO (Async (TypecheckedUnisonFile Symbol Ann))
-> MaybeT m (Async (TypecheckedUnisonFile Symbol Ann))
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async (TypecheckedUnisonFile Symbol Ann))
 -> MaybeT m (Async (TypecheckedUnisonFile Symbol Ann)))
-> (IO (TypecheckedUnisonFile Symbol Ann)
    -> IO (Async (TypecheckedUnisonFile Symbol Ann)))
-> IO (TypecheckedUnisonFile Symbol Ann)
-> MaybeT m (Async (TypecheckedUnisonFile Symbol Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (TypecheckedUnisonFile Symbol Ann)
-> IO (Async (TypecheckedUnisonFile Symbol Ann))
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
UnliftIO.async (IO (TypecheckedUnisonFile Symbol Ann)
 -> MaybeT m (Async (TypecheckedUnisonFile Symbol Ann)))
-> IO (TypecheckedUnisonFile Symbol Ann)
-> MaybeT m (Async (TypecheckedUnisonFile Symbol Ann))
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann
-> IO (TypecheckedUnisonFile Symbol Ann)
forall (m :: * -> *) a. MonadIO m => a -> m a
UnliftIO.evaluate TypecheckedUnisonFile Symbol Ann
IOSource.typecheckedFile
      MaybeT m Bool
checkBuiltinsReady <- IO (MaybeT m Bool) -> MaybeT m (MaybeT m Bool)
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
        MaybeT m Bool -> IO (MaybeT m Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( Async (TypecheckedUnisonFile Symbol Ann)
-> MaybeT
     m (Maybe (Either SomeException (TypecheckedUnisonFile Symbol Ann)))
forall (m :: * -> *) a.
MonadIO m =>
Async a -> m (Maybe (Either SomeException a))
UnliftIO.poll Async (TypecheckedUnisonFile Symbol Ann)
builtinsAsync
              MaybeT
  m (Maybe (Either SomeException (TypecheckedUnisonFile Symbol Ann)))
-> (Maybe (Either SomeException (TypecheckedUnisonFile Symbol Ann))
    -> Bool)
-> MaybeT m Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \case
                      Maybe (Either SomeException (TypecheckedUnisonFile Symbol Ann))
Nothing -> Bool
False
                      Just (Left {}) -> Bool
False
                      Just (Right {}) -> Bool
True
                  )
          )
      [Text]
renderedDocs <-
        -- We don't want to block the type signature hover info if the docs are taking a long time to render;
        -- We know it's also possible to write docs that eval forever, so the timeout helps
        -- protect against that.
        m (Maybe [Text]) -> MaybeT m (Maybe [Text])
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> m [Text] -> m (Maybe [Text])
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
UnliftIO.timeout Int
2_000_000 (Uri -> HashQualified Name -> m [Text]
forall (m :: * -> *).
Lspish m =>
Uri -> HashQualified Name -> m [Text]
LSPQ.markdownDocsForFQN Uri
uri HashQualified Name
fqn))
          MaybeT m (Maybe [Text])
-> (Maybe [Text] -> MaybeT m [Text]) -> MaybeT m [Text]
forall a b. MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \case
                  Maybe [Text]
Nothing ->
                    MaybeT m Bool
checkBuiltinsReady MaybeT m Bool -> (Bool -> MaybeT m [Text]) -> MaybeT m [Text]
forall a b. MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                      Bool
False -> [Text] -> MaybeT m [Text]
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
"\n---\n🔜 Doc renderer is initializing, try again in a few seconds."]
                      Bool
True -> [Text] -> MaybeT m [Text]
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
"\n---\n⏳ Timeout evaluating docs"]
                  Just [] -> [Text] -> MaybeT m [Text]
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                  -- Add some space from the type signature
                  Just xs :: [Text]
xs@(Text
_ : [Text]
_) -> [Text] -> MaybeT m [Text]
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"\n---\n" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs)
              )
      Text
typeSig <-
        case LabeledDependency
ref of
          LD.TypeReference (Reference.Builtin {}) -> do
            Text -> MaybeT m Text
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
symAtCursor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" : <builtin>")
          LD.TypeReference ref :: Reference
ref@(Reference.DerivedId Id' Hash
refId) -> do
            Name
nameAtCursor <- m (Maybe Name) -> MaybeT m Name
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Name) -> MaybeT m Name)
-> (Maybe Name -> m (Maybe Name)) -> Maybe Name -> MaybeT m Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Name -> m (Maybe Name)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Name -> MaybeT m Name) -> Maybe Name -> MaybeT m Name
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Name
Name.parseText Text
symAtCursor
            Decl Symbol Ann
decl <- Uri -> Id' Hash -> MaybeT m (Decl Symbol Ann)
forall (m :: * -> *).
Lspish m =>
Uri -> Id' Hash -> MaybeT m (Decl Symbol Ann)
LSPQ.getTypeDeclaration Uri
uri Id' Hash
refId
            let typ :: Text
typ =
                  String -> Text
Text.pack (String -> Text)
-> (Pretty SyntaxText -> String) -> Pretty SyntaxText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty ColorText -> String
Pretty.toPlain Width
prettyWidth (Pretty ColorText -> String)
-> (Pretty SyntaxText -> Pretty ColorText)
-> Pretty SyntaxText
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
Pretty.syntaxToColor (Pretty SyntaxText -> Text) -> Pretty SyntaxText -> Text
forall a b. (a -> b) -> a -> b
$
                    PrettyPrintEnvDecl
-> RenderUniqueTypeGuids
-> Reference
-> HashQualified Name
-> Decl Symbol Ann
-> Pretty SyntaxText
forall v a.
Var v =>
PrettyPrintEnvDecl
-> RenderUniqueTypeGuids
-> Reference
-> HashQualified Name
-> Decl v a
-> Pretty SyntaxText
DeclPrinter.prettyDecl PrettyPrintEnvDecl
pped RenderUniqueTypeGuids
DeclPrinter.RenderUniqueTypeGuids'No Reference
ref (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly Name
nameAtCursor) Decl Symbol Ann
decl
            Text -> MaybeT m Text
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
typ
          LD.TermReferent Referent
ref -> do
            Type Symbol Ann
typ <- Uri -> Referent -> MaybeT m (Type Symbol Ann)
forall (m :: * -> *).
Lspish m =>
Uri -> Referent -> MaybeT m (Type Symbol Ann)
LSPQ.getTypeOfReferent Uri
uri Referent
ref
            Text -> MaybeT m Text
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> MaybeT m Text) -> Text -> MaybeT m Text
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl -> Text -> Type Symbol Ann -> Text
forall v a. Var v => PrettyPrintEnvDecl -> Text -> Type v a -> Text
renderTypeSigForHover PrettyPrintEnvDecl
pped Text
symAtCursor Type Symbol Ann
typ
      Text -> MaybeT m Text
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> MaybeT m Text)
-> ([Text] -> Text) -> [Text] -> MaybeT m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unlines ([Text] -> MaybeT m Text) -> [Text] -> MaybeT m Text
forall a b. (a -> b) -> a -> b
$ [Text
typeSig] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
renderedDocs

    renderTypeSigForHover :: (Var v) => PPED.PrettyPrintEnvDecl -> Text -> Type.Type v a -> Text
    renderTypeSigForHover :: forall v a. Var v => PrettyPrintEnvDecl -> Text -> Type v a -> Text
renderTypeSigForHover PrettyPrintEnvDecl
pped Text
name Type v a
typ =
      let renderedType :: Text
renderedType = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Width -> PrettyPrintEnv -> Type v a -> String
forall v a.
Var v =>
Maybe Width -> PrettyPrintEnv -> Type v a -> String
TypePrinter.prettyStr (Width -> Maybe Width
forall a. a -> Maybe a
Just Width
prettyWidth) (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped) Type v a
typ
       in Text -> Text
markdownify (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
renderedType)

    hoverInfoForLiteral :: MaybeT m Text
    hoverInfoForLiteral :: MaybeT m Text
hoverInfoForLiteral =
      Text -> Text
markdownify (Text -> Text) -> MaybeT m Text -> MaybeT m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        Uri -> Position -> MaybeT m (SourceNode Ann)
forall (m :: * -> *).
Lspish m =>
Uri -> Position -> MaybeT m (SourceNode Ann)
LSPQ.nodeAtPosition Uri
uri Position
pos MaybeT m (SourceNode Ann)
-> (SourceNode Ann -> MaybeT m Text) -> MaybeT m Text
forall a b. MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          LSPQ.TermNode Term Symbol Ann
term -> do
            Text
typ <- Maybe Text -> MaybeT m Text
forall a. Maybe a -> MaybeT m a
hoistMaybe (Maybe Text -> MaybeT m Text) -> Maybe Text -> MaybeT m Text
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> Maybe Text
builtinTypeForTermLiterals Term Symbol Ann
term
            Text -> MaybeT m Text
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typ)
          LSPQ.TypeNode {} -> MaybeT m Text
forall a. MaybeT m a
forall (f :: * -> *) a. Alternative f => f a
empty
          LSPQ.PatternNode Pattern Ann
pat -> do
            Text
typ <- Maybe Text -> MaybeT m Text
forall a. Maybe a -> MaybeT m a
hoistMaybe (Maybe Text -> MaybeT m Text) -> Maybe Text -> MaybeT m Text
forall a b. (a -> b) -> a -> b
$ Pattern Ann -> Maybe Text
builtinTypeForPatternLiterals Pattern Ann
pat
            Text -> MaybeT m Text
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typ)

    hoverInfoForLocalVar :: MaybeT m Text
    hoverInfoForLocalVar :: MaybeT m Text
hoverInfoForLocalVar = do
      Symbol
localVar <- Uri
-> Position
-> (SourceNode Ann -> MaybeT m Symbol)
-> MaybeT m Symbol
forall (m :: * -> *) a.
Lspish m =>
Uri -> Position -> (SourceNode Ann -> MaybeT m a) -> MaybeT m a
LSPQ.nodeAtPositionMatching Uri
uri Position
pos \case
        LSPQ.TypeNode {} -> MaybeT m Symbol
forall a. MaybeT m a
forall (f :: * -> *) a. Alternative f => f a
empty
        LSPQ.PatternNode {} -> MaybeT m Symbol
forall a. MaybeT m a
forall (f :: * -> *) a. Alternative f => f a
empty
        LSPQ.TermNode Term Symbol Ann
trm -> case Term Symbol Ann
trm of
          (Term.Var' Symbol
v) -> Symbol -> MaybeT m Symbol
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Symbol
v
          (ABT.Abs'' Symbol
v Term Symbol Ann
_body) -> Symbol -> MaybeT m Symbol
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Symbol
v
          Term Symbol Ann
_ -> MaybeT m Symbol
forall a. MaybeT m a
forall (f :: * -> *) a. Alternative f => f a
empty
      FileAnalysis {IntervalMap Position (Type Symbol Ann)
localBindingTypes :: IntervalMap Position (Type Symbol Ann)
$sel:localBindingTypes:FileAnalysis :: FileAnalysis -> IntervalMap Position (Type Symbol Ann)
localBindingTypes} <- Uri -> MaybeT m FileAnalysis
forall (m :: * -> *). Lspish m => Uri -> MaybeT m FileAnalysis
FileAnalysis.getFileAnalysis Uri
uri
      (Interval Position
_range, Type Symbol Ann
typ) <- Maybe (Interval Position, Type Symbol Ann)
-> MaybeT m (Interval Position, Type Symbol Ann)
forall a. Maybe a -> MaybeT m a
hoistMaybe (Maybe (Interval Position, Type Symbol Ann)
 -> MaybeT m (Interval Position, Type Symbol Ann))
-> Maybe (Interval Position, Type Symbol Ann)
-> MaybeT m (Interval Position, Type Symbol Ann)
forall a b. (a -> b) -> a -> b
$ IntervalMap Position (Type Symbol Ann)
-> Maybe (Interval Position, Type Symbol Ann)
forall k v. IntervalMap k v -> Maybe (k, v)
IM.lookupMin (IntervalMap Position (Type Symbol Ann)
 -> Maybe (Interval Position, Type Symbol Ann))
-> IntervalMap Position (Type Symbol Ann)
-> Maybe (Interval Position, Type Symbol Ann)
forall a b. (a -> b) -> a -> b
$ IntervalMap Position (Type Symbol Ann)
-> Interval Position -> IntervalMap Position (Type Symbol Ann)
forall k e v.
Interval k e =>
IntervalMap k v -> k -> IntervalMap k v
IM.intersecting IntervalMap Position (Type Symbol Ann)
localBindingTypes (Position -> Position -> Interval Position
forall a. a -> a -> Interval a
IM.ClosedInterval Position
pos Position
pos)

      PrettyPrintEnvDecl
pped <- m PrettyPrintEnvDecl -> MaybeT m PrettyPrintEnvDecl
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m PrettyPrintEnvDecl -> MaybeT m PrettyPrintEnvDecl)
-> m PrettyPrintEnvDecl -> MaybeT m PrettyPrintEnvDecl
forall a b. (a -> b) -> a -> b
$ Uri -> m PrettyPrintEnvDecl
forall (m :: * -> *). Lspish m => Uri -> m PrettyPrintEnvDecl
ppedForFile Uri
uri
      let varName :: Text
varName = case Symbol
localVar of
            (Symbol.Symbol Word64
_ (Var.User Text
name)) -> Text
name
            Symbol
_ -> Symbol -> Text
forall a. Show a => a -> Text
tShow Symbol
localVar
      Text -> MaybeT m Text
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> MaybeT m Text) -> Text -> MaybeT m Text
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl -> Text -> Type Symbol Ann -> Text
forall v a. Var v => PrettyPrintEnvDecl -> Text -> Type v a -> Text
renderTypeSigForHover PrettyPrintEnvDecl
pped Text
varName Type Symbol Ann
typ

    hoistMaybe :: Maybe a -> MaybeT m a
    hoistMaybe :: forall a. Maybe a -> MaybeT m a
hoistMaybe = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a)
-> (Maybe a -> m (Maybe a)) -> Maybe a -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Get the type for term literals.
builtinTypeForTermLiterals :: Term.Term Symbol Ann -> Maybe Text
builtinTypeForTermLiterals :: Term Symbol Ann -> Maybe Text
builtinTypeForTermLiterals Term Symbol Ann
term =
  case Term Symbol Ann -> ABT (F Symbol Ann Ann) Symbol (Term Symbol Ann)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out Term Symbol Ann
term of
    ABT.Tm F Symbol Ann Ann (Term Symbol Ann)
f -> case F Symbol Ann Ann (Term Symbol Ann)
f of
      Term.Int {} -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Int"
      Term.Nat {} -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Nat"
      Term.Float {} -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Float"
      Term.Boolean {} -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Boolean"
      Term.Text {} -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Text"
      Term.Char {} -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Char"
      Term.Blank {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.Ref {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.Constructor {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.Request {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.Handle {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.App {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.Ann {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.List {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.If {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.And {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.Or {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.Lam {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.LetRec {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.Let {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.Match {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.TermLink {} -> Maybe Text
forall a. Maybe a
Nothing
      Term.TypeLink {} -> Maybe Text
forall a. Maybe a
Nothing
    ABT.Var {} -> Maybe Text
forall a. Maybe a
Nothing
    ABT.Cycle {} -> Maybe Text
forall a. Maybe a
Nothing
    ABT.Abs {} -> Maybe Text
forall a. Maybe a
Nothing

builtinTypeForPatternLiterals :: Pattern.Pattern Ann -> Maybe Text
builtinTypeForPatternLiterals :: Pattern Ann -> Maybe Text
builtinTypeForPatternLiterals = \case
  Pattern.Unbound Ann
_ -> Maybe Text
forall a. Maybe a
Nothing
  Pattern.Var Ann
_ -> Maybe Text
forall a. Maybe a
Nothing
  Pattern.Boolean Ann
_ Bool
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Boolean"
  Pattern.Int Ann
_ Int64
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Int"
  Pattern.Nat Ann
_ Word64
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Nat"
  Pattern.Float Ann
_ Double
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Float"
  Pattern.Text Ann
_ Text
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Text"
  Pattern.Char Ann
_ Char
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Char"
  Pattern.Constructor Ann
_ ConstructorReference
_ [Pattern Ann]
_ -> Maybe Text
forall a. Maybe a
Nothing
  Pattern.As Ann
_ Pattern Ann
_ -> Maybe Text
forall a. Maybe a
Nothing
  Pattern.EffectPure Ann
_ Pattern Ann
_ -> Maybe Text
forall a. Maybe a
Nothing
  Pattern.EffectBind Ann
_ ConstructorReference
_ [Pattern Ann]
_ Pattern Ann
_ -> Maybe Text
forall a. Maybe a
Nothing
  Pattern.SequenceLiteral Ann
_ [Pattern Ann]
_ -> Maybe Text
forall a. Maybe a
Nothing
  Pattern.SequenceOp Ann
_ Pattern Ann
_ SeqOp
_ Pattern Ann
_ -> Maybe Text
forall a. Maybe a
Nothing