X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnHsDoc.hs;h=9fb9348eb0df4d4a9d950a7ceff80cab1952453c;hb=72e37dedee9e8a109ebda4b13e49b7133b530591;hp=6941da59c162a1dc6270d2fbfd72b75051aaf136;hpb=190f24892156953d73b55401d0467a6f1a88ce5d;p=ghc-hetmet.git diff --git a/compiler/rename/RnHsDoc.hs b/compiler/rename/RnHsDoc.hs index 6941da5..9fb9348 100644 --- a/compiler/rename/RnHsDoc.hs +++ b/compiler/rename/RnHsDoc.hs @@ -1,17 +1,29 @@ -module RnHsDoc ( rnHsDoc, rnLHsDoc, rnMbLHsDoc, rnMbHsDoc ) where +module RnHsDoc ( rnHaddock, rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where +import TcRnTypes import TcRnMonad ( RnM ) -import RnEnv ( dataTcOccs, lookupGreRn ) -import HsDoc ( HsDoc(..) ) +import RnEnv ( dataTcOccs, lookupGreRn_maybe ) +import HsSyn -import RdrName ( RdrName, isRdrDataCon, isRdrTc, gre_name ) +import RdrName ( RdrName, gre_name ) import Name ( Name ) import SrcLoc ( Located(..) ) import Outputable ( ppr, defaultUserStyle ) -import Data.List ( (\\) ) -import Debug.Trace ( trace ) +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 @@ -49,7 +61,7 @@ rnHsDoc doc = case doc of DocIdentifier ids -> do let choices = concatMap dataTcOccs ids - mb_gres <- mapM lookupGreRn choices + mb_gres <- mapM lookupGreRn_maybe choices case [gre_name gre | Just gre <- mb_gres] of [] -> return (DocString (ids2string ids)) ids' -> return (DocIdentifier ids')