blob: a1e05c913bcb41b7e3df8a2be9401347f0c1fb92 (
plain)
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
101
102
103
104
105
106
107
108
109
|
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
module RnHsDoc ( rnHaddock, rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where
import TcRnTypes
import TcRnMonad ( RnM )
import RnEnv ( dataTcOccs, lookupGreRn_maybe )
import HsSyn
import RdrName ( RdrName, gre_name )
import Name ( Name )
import SrcLoc ( Located(..) )
import Outputable ( ppr, defaultUserStyle )
rnHaddock :: HaddockModInfo RdrName -> Maybe (HsDoc RdrName)
-> TcGblEnv -> RnM TcGblEnv
rnHaddock module_info maybe_doc tcg_env
= do { rn_module_doc <- rnMbHsDoc maybe_doc ;
-- Rename the Haddock module info
; rn_description <- rnMbHsDoc (hmi_description module_info)
; let { rn_module_info = module_info { hmi_description = rn_description } }
; return (tcg_env { tcg_doc = rn_module_doc,
tcg_hmi = rn_module_info }) }
rnMbHsDoc :: Maybe (HsDoc RdrName) -> RnM (Maybe (HsDoc Name))
rnMbHsDoc mb_doc = case mb_doc of
Just doc -> do
doc' <- rnHsDoc doc
return (Just doc')
Nothing -> return Nothing
rnMbLHsDoc mb_doc = case mb_doc of
Just doc -> do
doc' <- rnLHsDoc doc
return (Just doc')
Nothing -> return Nothing
rnLHsDoc (L pos doc) = do
doc' <- rnHsDoc doc
return (L pos doc')
ids2string [] = []
ids2string (x:_) = show $ ppr x defaultUserStyle
rnHsDoc :: HsDoc RdrName -> RnM (HsDoc Name)
rnHsDoc doc = case doc of
DocEmpty -> return DocEmpty
DocAppend a b -> do
a' <- rnHsDoc a
b' <- rnHsDoc b
return (DocAppend a' b')
DocString str -> return (DocString str)
DocParagraph doc -> do
doc' <- rnHsDoc doc
return (DocParagraph doc')
DocIdentifier ids -> do
let choices = concatMap dataTcOccs ids
mb_gres <- mapM lookupGreRn_maybe choices
case [gre_name gre | Just gre <- mb_gres] of
[] -> return (DocString (ids2string ids))
ids' -> return (DocIdentifier ids')
DocModule str -> return (DocModule str)
DocEmphasis doc -> do
doc' <- rnHsDoc doc
return (DocEmphasis doc')
DocMonospaced doc -> do
doc' <- rnHsDoc doc
return (DocMonospaced doc')
DocUnorderedList docs -> do
docs' <- mapM rnHsDoc docs
return (DocUnorderedList docs')
DocOrderedList docs -> do
docs' <- mapM rnHsDoc docs
return (DocOrderedList docs')
DocDefList list -> do
list' <- mapM (\(a,b) -> do
a' <- rnHsDoc a
b' <- rnHsDoc b
return (a', b')) list
return (DocDefList list')
DocCodeBlock doc -> do
doc' <- rnHsDoc doc
return (DocCodeBlock doc')
DocURL str -> return (DocURL str)
DocPic str -> return (DocPic str)
DocAName str -> return (DocAName str)
|
