module Development.IDE.Spans.AtPoint (
atPoint
, gotoDefinition
) where
import Development.IDE.GHC.Error
import Development.IDE.GHC.Orphans()
import Development.IDE.Types.Location
import Development.IDE.GHC.Compat
import Development.IDE.Types.Options
import Development.IDE.Spans.Type as SpanInfo
import Development.IDE.Spans.Common (spanDocToMarkdown)
import DynFlags
import FastString
import Name
import Outputable hiding ((<>))
import SrcLoc
import Type
import VarSet
import Control.Monad.Extra
import Control.Monad.Trans.Maybe
import Control.Monad.IO.Class
import Data.Maybe
import Data.List
import qualified Data.Text as T
gotoDefinition
:: MonadIO m
=> (Module -> m (Maybe (HieFile, FilePath)))
-> IdeOptions
-> [SpanInfo]
-> Position
-> m (Maybe Location)
gotoDefinition getHieFile ideOpts srcSpans pos =
listToMaybe <$> locationsAtPoint getHieFile ideOpts pos srcSpans
atPoint
:: IdeOptions
-> SpansInfo
-> Position
-> Maybe (Maybe Range, [T.Text])
atPoint IdeOptions{..} (SpansInfo srcSpans cntsSpans) pos = do
firstSpan <- listToMaybe $ deEmpasizeGeneratedEqShow $ spansAtPoint pos srcSpans
let constraintsAtPoint = mapMaybe spaninfoType (spansAtPoint pos cntsSpans)
return (Just (range firstSpan), hoverInfo firstSpan constraintsAtPoint)
where
hoverInfo SpanInfo{spaninfoType = Nothing , spaninfoDocs = docs , ..} _ =
(wrapLanguageSyntax <$> name) <> location <> spanDocToMarkdown docs
where
name = [maybe shouldNotHappen showName mbName]
location = [maybe shouldNotHappen definedAt mbName]
shouldNotHappen = "ghcide: did not expect a type level component without a name"
mbName = getNameM spaninfoSource
hoverInfo SpanInfo{spaninfoType = (Just typ), spaninfoDocs = docs , ..} cnts =
(wrapLanguageSyntax <$> nameOrSource) <> location <> spanDocToMarkdown docs
where
mbName = getNameM spaninfoSource
expr = case spaninfoSource of
Named n -> qualifyNameIfPossible n
Lit l -> crop $ T.pack l
_ -> ""
nameOrSource = [expr <> "\n" <> typeAnnotation]
qualifyNameIfPossible name' = modulePrefix <> showName name'
where modulePrefix = maybe "" (<> ".") (getModuleNameAsText name')
location = [maybe "" definedAt mbName]
thisFVs = tyCoVarsOfType typ
constraintsOverFVs = filter (\cnt -> not (tyCoVarsOfType cnt `disjointVarSet` thisFVs)) cnts
constraintsT = T.intercalate ", " (map showName constraintsOverFVs)
typeAnnotation = case constraintsOverFVs of
[] -> colon <> showName typ
[_] -> colon <> constraintsT <> "\n=> " <> showName typ
_ -> colon <> "(" <> constraintsT <> ")\n=> " <> showName typ
definedAt name = "*Defined " <> T.pack (showSDocUnsafe $ pprNameDefnLoc name) <> "*\n"
crop txt
| T.length txt > 50 = T.take 46 txt <> " ..."
| otherwise = txt
range SpanInfo{..} = Range
(Position spaninfoStartLine spaninfoStartCol)
(Position spaninfoEndLine spaninfoEndCol)
colon = if optNewColonConvention then ": " else ":: "
wrapLanguageSyntax x = T.unlines [ "```" <> T.pack optLanguageSyntax, x, "```"]
deEmpasizeGeneratedEqShow :: [SpanInfo] -> [SpanInfo]
deEmpasizeGeneratedEqShow = uncurry (++) . partition (not . isTypeclassDeclSpan)
isTypeclassDeclSpan :: SpanInfo -> Bool
isTypeclassDeclSpan spanInfo =
case getNameM (spaninfoSource spanInfo) of
Just name -> any (`isInfixOf` getOccString name) ["==", "showsPrec"]
Nothing -> False
locationsAtPoint
:: forall m
. MonadIO m
=> (Module -> m (Maybe (HieFile, FilePath)))
-> IdeOptions
-> Position
-> [SpanInfo]
-> m [Location]
locationsAtPoint getHieFile _ideOptions pos =
fmap (map srcSpanToLocation) . mapMaybeM (getSpan . spaninfoSource) . spansAtPoint pos
where getSpan :: SpanSource -> m (Maybe SrcSpan)
getSpan NoSource = pure Nothing
getSpan (SpanS sp) = pure $ Just sp
getSpan (Lit _) = pure Nothing
getSpan (Named name) = case nameSrcSpan name of
sp@(RealSrcSpan _) -> pure $ Just sp
sp@(UnhelpfulSpan _) -> runMaybeT $ do
guard (sp /= wiredInSrcSpan)
mod <- MaybeT $ return $ nameModule_maybe name
(hieFile, srcPath) <- MaybeT $ getHieFile mod
avail <- MaybeT $ pure $ find (eqName name . snd) $ hieExportNames hieFile
let span = setFileName srcPath $ fst avail
pure span
eqName :: Name -> Name -> Bool
eqName n n' = nameOccName n == nameOccName n' && nameModule_maybe n == nameModule_maybe n'
setFileName f (RealSrcSpan span) = RealSrcSpan (span { srcSpanFile = mkFastString f })
setFileName _ span@(UnhelpfulSpan _) = span
spansAtPoint :: Position -> [SpanInfo] -> [SpanInfo]
spansAtPoint pos = filter atp where
line = _line pos
cha = _character pos
atp SpanInfo{..} =
startsBeforePosition && endsAfterPosition
where
startLineCmp = compare spaninfoStartLine line
endLineCmp = compare spaninfoEndLine line
startsBeforePosition = startLineCmp == LT || (startLineCmp == EQ && spaninfoStartCol <= cha)
endsAfterPosition = endLineCmp == GT || (endLineCmp == EQ && spaninfoEndCol > cha)
showName :: Outputable a => a -> T.Text
showName = T.pack . prettyprint
where
prettyprint x = renderWithStyle unsafeGlobalDynFlags (ppr x) style
style = mkUserStyle unsafeGlobalDynFlags neverQualify AllTheWay
getModuleNameAsText :: Name -> Maybe T.Text
getModuleNameAsText n = do
m <- nameModule_maybe n
return . T.pack . moduleNameString $ moduleName m