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