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)