blob: 0b5efe4b46dc45c3c353e2b7818d2b7139d131dc (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
module Haddock.Interface.Rn ( rnDoc, rnHaddockModInfo ) where
import Haddock.Types
import RnEnv ( dataTcOccs )
import RdrName
import Name ( Name, isTyConName )
import Outputable ( ppr, showSDoc )
rnHaddockModInfo :: GlobalRdrEnv -> HaddockModInfo RdrName -> HaddockModInfo Name
rnHaddockModInfo gre hmod =
let desc = hmi_description hmod
in hmod { hmi_description = fmap (rnDoc gre) desc }
data Id x = Id {unId::x}
instance Monad Id where (Id v)>>=f = f v; return = Id
rnDoc :: GlobalRdrEnv -> Doc RdrName -> Doc Name
rnDoc gre = unId . do_rn
where
do_rn doc_to_rn = case doc_to_rn of
DocEmpty -> return DocEmpty
DocAppend a b -> do
a' <- do_rn a
b' <- do_rn b
return (DocAppend a' b')
DocString str -> return (DocString str)
DocParagraph doc -> do
doc' <- do_rn doc
return (DocParagraph doc')
DocIdentifier x -> do
let choices = dataTcOccs x
let names = concatMap (\c -> map gre_name (lookupGRE_RdrName c gre)) choices
return $
case names of
[] ->
case choices of
[] -> DocMonospaced (DocString (showSDoc $ ppr x))
[a] -> outOfScope a
a:b:_ | isRdrTc a -> outOfScope a | otherwise -> outOfScope b
[a] -> DocIdentifier a
a:b:_ | isTyConName a -> DocIdentifier a | otherwise -> DocIdentifier b
-- If an id can refer to multiple things, we give precedence to type
-- constructors.
DocIdentifierUnchecked x -> return (DocIdentifierUnchecked x)
DocModule str -> return (DocModule str)
DocEmphasis doc -> do
doc' <- do_rn doc
return (DocEmphasis doc')
DocMonospaced doc -> do
doc' <- do_rn doc
return (DocMonospaced doc')
DocUnorderedList docs -> do
docs' <- mapM do_rn docs
return (DocUnorderedList docs')
DocOrderedList docs -> do
docs' <- mapM do_rn docs
return (DocOrderedList docs')
DocDefList list -> do
list' <- mapM (\(a,b) -> do
a' <- do_rn a
b' <- do_rn b
return (a', b')) list
return (DocDefList list')
DocCodeBlock doc -> do
doc' <- do_rn doc
return (DocCodeBlock doc')
DocURL str -> return (DocURL str)
DocPic str -> return (DocPic str)
DocAName str -> return (DocAName str)
DocExamples e -> return (DocExamples e)
outOfScope :: RdrName -> Doc a
outOfScope x =
case x of
Unqual occ -> monospaced occ
Qual mdl occ -> DocIdentifierUnchecked (mdl, occ)
Orig _ occ -> monospaced occ
Exact name -> monospaced name -- Shouldn't happen since x is out of scope
where
monospaced a = DocMonospaced (DocString (showSDoc $ ppr a))
|
