module Development.IDE.Spans.Documentation (
getDocumentation
) where
import Control.Monad
import Data.List.Extra
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Text as T
import Development.IDE.GHC.Error
import Development.IDE.Spans.Calculate
import FastString
import GHC
import SrcLoc
getDocumentation
:: Name
-> [TypecheckedModule]
-> [T.Text]
getDocumentation targetName tcs = fromMaybe [] $ do
targetNameSpan <- realSpan $ nameSrcSpan targetName
tc <-
listToMaybe
$ filter ((==) (Just $ srcSpanFile targetNameSpan) . annotationFileName)
$ reverse tcs
let bs = mapMaybe name_of_bind
(listifyAllSpans (tm_typechecked_source tc) :: [LHsBind GhcTc])
let sortedSpans = sortedNameSpans bs
let docs = ann tc
nameInd <- elemIndex targetNameSpan sortedSpans
let prevNameSpan =
if nameInd >= 1
then sortedSpans !! (nameInd - 1)
else zeroSpan $ srcSpanFile targetNameSpan
pure
$ docHeaders
$ filter (\(L target _) -> isBetween target prevNameSpan targetNameSpan)
$ mapMaybe (\(L l v) -> L <$> realSpan l <*> pure v)
$ join
$ M.elems
docs
where
name_of_bind :: LHsBind GhcTc -> Maybe Name
name_of_bind (L _ FunBind {fun_id}) = Just (getName (unLoc fun_id))
name_of_bind _ = Nothing
sortedNameSpans :: [Name] -> [RealSrcSpan]
sortedNameSpans ls = nubSort (mapMaybe (realSpan . nameSrcSpan) ls)
isBetween target before after = before <= target && target <= after
ann = snd . pm_annotations . tm_parsed_module
annotationFileName :: TypecheckedModule -> Maybe FastString
annotationFileName = fmap srcSpanFile . listToMaybe . realSpans . ann
realSpans :: M.Map SrcSpan [Located a] -> [RealSrcSpan]
realSpans =
mapMaybe (realSpan . getLoc)
. join
. M.elems
docHeaders :: [RealLocated AnnotationComment]
-> [T.Text]
docHeaders = mapMaybe (\(L _ x) -> wrk x)
where
wrk = \case
AnnDocCommentNext s -> Just $ T.pack s
AnnLineComment s -> if "-- |" `isPrefixOf` s
then Just $ T.pack s
else Nothing
_ -> Nothing