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
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
}
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 <-
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 []
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
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