git.iko.soy/ghcide
on b9dfd49 help sign in
ghcide/src/Development/IDE/Functions/Documentation.hs
87 lines 3.5 kB history raw
1-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
4module Development.IDE.Functions.Documentation (
5 getDocumentation
6 , docHeaders
7 ) where
9import Control.Monad
10import Data.List.Extra
11import qualified Data.Map as M
12import Data.Maybe
13import qualified Data.Text as T
14import Development.IDE.Functions.GHCError
15import Development.IDE.Functions.SpanInfo
16import FastString
17import GHC
18import SrcLoc
21getDocumentation
22 :: Name -- ^ The name you want documentation for.
23 -> [TypecheckedModule] -- ^ All of the possible modules it could be defined in.
24 -> [RealLocated AnnotationComment]
25-- This finds any documentation between the name you want
26-- documentation for and the one before it. This is only an
27-- approximately correct algorithm and there are easily constructed
28-- cases where it will be wrong (if so then usually slightly but there
29-- may be edge cases where it is very wrong).
30-- TODO : Build a version of GHC exactprint to extract this information
31-- more accurately.
32getDocumentation targetName tcs = fromMaybe [] $ do
33 -- Find the module the target is defined in.
34 targetNameSpan <- realSpan $ nameSrcSpan targetName
35 tc <-
36 listToMaybe
37 $ filter ((==) (Just $ srcSpanFile targetNameSpan) . annotationFileName)
38 $ reverse tcs -- TODO : Is reversing the list here really neccessary?
39 -- Names bound by the module (we want to exclude non-"top-level"
40 -- bindings but unfortunately we get all here).
41 let bs = mapMaybe name_of_bind
42 (listifyAllSpans (tm_typechecked_source tc) :: [LHsBind GhcTc])
43 -- Sort the names' source spans.
44 let sortedSpans = sortedNameSpans bs
45 -- Now go ahead and extract the docs.
46 let docs = ann tc
47 nameInd <- elemIndex targetNameSpan sortedSpans
48 let prevNameSpan =
49 if nameInd >= 1
50 then sortedSpans !! (nameInd - 1)
51 else zeroSpan $ srcSpanFile targetNameSpan
52 -- Annoyingly "-- |" documentation isn't annotated with a location,
53 -- so you have to pull it out from the elements.
54 pure
55 $ filter (\(L target _) -> isBetween target prevNameSpan targetNameSpan)
56 $ mapMaybe (\(L l v) -> L <$> realSpan l <*> pure v)
57 $ join
58 $ M.elems
59 docs
60 where
61 -- Get the name bound by a binding. We only concern ourselves with
62 -- @FunBind@ (which covers functions and variables).
63 name_of_bind :: LHsBind GhcTc -> Maybe Name
64 name_of_bind (L _ FunBind {fun_id}) = Just (getName (unLoc fun_id))
65 name_of_bind _ = Nothing
66 -- Get source spans from names, discard unhelpful spans, remove
67 -- duplicates and sort.
68 sortedNameSpans :: [Name] -> [RealSrcSpan]
69 sortedNameSpans ls = nubSort (mapMaybe (realSpan . nameSrcSpan) ls)
70 isBetween target before after = before <= target && target <= after
71 ann = snd . pm_annotations . tm_parsed_module
72 annotationFileName :: TypecheckedModule -> Maybe FastString
73 annotationFileName = fmap srcSpanFile . listToMaybe . realSpans . ann
74 realSpans :: M.Map SrcSpan [Located a] -> [RealSrcSpan]
75 realSpans =
76 mapMaybe (realSpan . getLoc)
77 . join
78 . M.elems
80-- | Shows this part of the documentation
81docHeaders :: [RealLocated AnnotationComment]
82 -> [T.Text]
83docHeaders = mapMaybe (wrk . unRealSrcSpan)
84 where
85 wrk = \case
86 AnnDocCommentNext s -> Just $ T.pack s
87 _ -> Nothing