compiler/rename/RnHsDoc.hs

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