Add a -fwarn-dodgy-exports flag; fixes #1911
[ghc.git] / compiler / rename / RnHsDoc.hs
1
2 module RnHsDoc ( rnHaddock, rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where
3
4 import TcRnTypes
5 import RnEnv ( dataTcOccs, lookupGreRn_maybe )
6 import HsSyn
7
8 import RdrName ( RdrName, gre_name )
9 import Name ( Name )
10 import SrcLoc ( Located(..) )
11 import Outputable ( ppr, defaultUserStyle )
12
13
14 rnHaddock :: HaddockModInfo RdrName -> Maybe (HsDoc RdrName)
15 -> TcGblEnv -> RnM TcGblEnv
16 rnHaddock module_info maybe_doc tcg_env
17 = do { rn_module_doc <- rnMbHsDoc maybe_doc ;
18
19 -- Rename the Haddock module info
20 ; rn_description <- rnMbHsDoc (hmi_description module_info)
21 ; let { rn_module_info = module_info { hmi_description = rn_description } }
22
23 ; return (tcg_env { tcg_doc = rn_module_doc,
24 tcg_hmi = rn_module_info }) }
25
26 rnMbHsDoc :: Maybe (HsDoc RdrName) -> RnM (Maybe (HsDoc Name))
27 rnMbHsDoc mb_doc = case mb_doc of
28 Just doc -> do
29 doc' <- rnHsDoc doc
30 return (Just doc')
31 Nothing -> return Nothing
32
33 rnMbLHsDoc :: Maybe (LHsDoc RdrName) -> RnM (Maybe (LHsDoc Name))
34 rnMbLHsDoc mb_doc = case mb_doc of
35 Just doc -> do
36 doc' <- rnLHsDoc doc
37 return (Just doc')
38 Nothing -> return Nothing
39
40 rnLHsDoc :: LHsDoc RdrName -> RnM (LHsDoc Name)
41 rnLHsDoc (L pos doc) = do
42 doc' <- rnHsDoc doc
43 return (L pos doc')
44
45 ids2string :: [RdrName] -> String
46 ids2string [] = []
47 ids2string (x:_) = show $ ppr x defaultUserStyle
48
49 rnHsDoc :: HsDoc RdrName -> RnM (HsDoc Name)
50 rnHsDoc doc = case doc of
51
52 DocEmpty -> return DocEmpty
53
54 DocAppend a b -> do
55 a' <- rnHsDoc a
56 b' <- rnHsDoc b
57 return (DocAppend a' b')
58
59 DocString str -> return (DocString str)
60
61 DocParagraph doc -> do
62 doc' <- rnHsDoc doc
63 return (DocParagraph doc')
64
65 DocIdentifier ids -> do
66 let choices = concatMap dataTcOccs ids
67 mb_gres <- mapM lookupGreRn_maybe choices
68 case [gre_name gre | Just gre <- mb_gres] of
69 [] -> return (DocString (ids2string ids))
70 ids' -> return (DocIdentifier ids')
71
72 DocModule str -> return (DocModule str)
73
74 DocEmphasis doc -> do
75 doc' <- rnHsDoc doc
76 return (DocEmphasis doc')
77
78 DocMonospaced doc -> do
79 doc' <- rnHsDoc doc
80 return (DocMonospaced doc')
81
82 DocUnorderedList docs -> do
83 docs' <- mapM rnHsDoc docs
84 return (DocUnorderedList docs')
85
86 DocOrderedList docs -> do
87 docs' <- mapM rnHsDoc docs
88 return (DocOrderedList docs')
89
90 DocDefList list -> do
91 list' <- mapM (\(a,b) -> do
92 a' <- rnHsDoc a
93 b' <- rnHsDoc b
94 return (a', b')) list
95 return (DocDefList list')
96
97 DocCodeBlock doc -> do
98 doc' <- rnHsDoc doc
99 return (DocCodeBlock doc')
100
101 DocURL str -> return (DocURL str)
102
103 DocPic str -> return (DocPic str)
104
105 DocAName str -> return (DocAName str)