compiler/rename/RnHsDoc.hs

   1 module RnHsDoc ( rnHsDoc, rnLHsDoc, rnMbLHsDoc, rnMbHsDoc ) where
   2
   3 import TcRnMonad   ( RnM )
   4 import RnEnv       ( dataTcOccs, lookupGreRn )
   5 import HsDoc       ( HsDoc(..) )
   6
   7 import RdrName     ( RdrName, isRdrDataCon, isRdrTc, gre_name )
   8 import Name        ( Name )
   9 import SrcLoc      ( Located(..) )
  10 import Outputable  ( ppr, defaultUserStyle )
  11
  12 import Data.List   ( (\\) )
  13 import Debug.Trace ( trace )
  14
  15 rnMbHsDoc mb_doc = case mb_doc of
  16   Just doc -> do
  17     doc' <- rnHsDoc doc
  18     return (Just doc')
  19   Nothing -> return Nothing
  20
  21 rnMbLHsDoc mb_doc = case mb_doc of
  22   Just doc -> do
  23     doc' <- rnLHsDoc doc
  24     return (Just doc')
  25   Nothing -> return Nothing
  26
  27 rnLHsDoc (L pos doc) = do
  28   doc' <- rnHsDoc doc
  29   return (L pos doc')
  30
  31 ids2string []    = []
  32 ids2string (x:_) = show $ ppr x defaultUserStyle
  33
  34 rnHsDoc :: HsDoc RdrName -> RnM (HsDoc Name)
  35 rnHsDoc doc = case doc of
  36
  37   DocEmpty -> return DocEmpty
  38
  39   DocAppend a b -> do
  40     a' <- rnHsDoc a
  41     b' <- rnHsDoc b
  42     return (DocAppend a' b')
  43
  44   DocString str -> return (DocString str)
  45
  46   DocParagraph doc -> do
  47     doc' <- rnHsDoc doc
  48     return (DocParagraph doc')
  49
  50   DocIdentifier ids -> do
  51     let choices = concatMap dataTcOccs ids
  52     mb_gres <- mapM lookupGreRn choices
  53     case [gre_name gre | Just gre <- mb_gres] of
  54       [] -> return (DocString (ids2string ids))
  55       ids' -> return (DocIdentifier ids')
  56
  57   DocModule str -> return (DocModule str)
  58
  59   DocEmphasis doc -> do
  60     doc' <- rnHsDoc doc
  61     return (DocEmphasis doc')
  62
  63   DocMonospaced doc -> do
  64     doc' <- rnHsDoc doc
  65     return (DocMonospaced doc')
  66
  67   DocUnorderedList docs -> do
  68     docs' <- mapM rnHsDoc docs
  69     return (DocUnorderedList docs')
  70
  71   DocOrderedList docs -> do
  72     docs' <- mapM rnHsDoc docs
  73     return (DocOrderedList docs')
  74
  75   DocDefList list -> do
  76     list' <- mapM (\(a,b) -> do
  77       a' <- rnHsDoc a
  78       b' <- rnHsDoc b
  79       return (a', b')) list
  80     return (DocDefList list')
  81
  82   DocCodeBlock doc -> do
  83     doc' <- rnHsDoc doc
  84     return (DocCodeBlock doc')
  85
  86   DocURL str -> return (DocURL str)
  87
  88   DocAName str -> return (DocAName str)