compiler/rename/RnHsDoc.hs

   1 module RnHsDoc ( rnHaddock, rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where
   2
   3 import TcRnTypes
   4 import TcRnMonad   ( RnM )
   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 mb_doc = case mb_doc of
  34   Just doc -> do
  35     doc' <- rnLHsDoc doc
  36     return (Just doc')
  37   Nothing -> return Nothing
  38
  39 rnLHsDoc (L pos doc) = do
  40   doc' <- rnHsDoc doc
  41   return (L pos doc')
  42
  43 ids2string []    = []
  44 ids2string (x:_) = show $ ppr x defaultUserStyle
  45
  46 rnHsDoc :: HsDoc RdrName -> RnM (HsDoc Name)
  47 rnHsDoc doc = case doc of
  48
  49   DocEmpty -> return DocEmpty
  50
  51   DocAppend a b -> do
  52     a' <- rnHsDoc a
  53     b' <- rnHsDoc b
  54     return (DocAppend a' b')
  55
  56   DocString str -> return (DocString str)
  57
  58   DocParagraph doc -> do
  59     doc' <- rnHsDoc doc
  60     return (DocParagraph doc')
  61
  62   DocIdentifier ids -> do
  63     let choices = concatMap dataTcOccs ids
  64     mb_gres <- mapM lookupGreRn_maybe choices
  65     case [gre_name gre | Just gre <- mb_gres] of
  66       [] -> return (DocString (ids2string ids))
  67       ids' -> return (DocIdentifier ids')
  68
  69   DocModule str -> return (DocModule str)
  70
  71   DocEmphasis doc -> do
  72     doc' <- rnHsDoc doc
  73     return (DocEmphasis doc')
  74
  75   DocMonospaced doc -> do
  76     doc' <- rnHsDoc doc
  77     return (DocMonospaced doc')
  78
  79   DocUnorderedList docs -> do
  80     docs' <- mapM rnHsDoc docs
  81     return (DocUnorderedList docs')
  82
  83   DocOrderedList docs -> do
  84     docs' <- mapM rnHsDoc docs
  85     return (DocOrderedList docs')
  86
  87   DocDefList list -> do
  88     list' <- mapM (\(a,b) -> do
  89       a' <- rnHsDoc a
  90       b' <- rnHsDoc b
  91       return (a', b')) list
  92     return (DocDefList list')
  93
  94   DocCodeBlock doc -> do
  95     doc' <- rnHsDoc doc
  96     return (DocCodeBlock doc')
  97
  98   DocURL str -> return (DocURL str)
  99
 100   DocAName str -> return (DocAName str)