X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnHsDoc.hs;h=d90b2fe500c2df11c24f0f13fb6029cb6f70132f;hp=4d10edca5e90622260cf94becbab9f63bd55f456;hb=63489d40bdee972656ff115ab2309b809c0e39fc;hpb=8a25c54e2df36b3fb40436e5b887dddc3c64ab54 diff --git a/compiler/rename/RnHsDoc.hs b/compiler/rename/RnHsDoc.hs index 4d10edc..d90b2fe 100644 --- a/compiler/rename/RnHsDoc.hs +++ b/compiler/rename/RnHsDoc.hs @@ -1,5 +1,5 @@ -module RnHsDoc ( rnHaddock, rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where +module RnHsDoc ( rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where import TcRnTypes import RnEnv ( dataTcOccs, lookupGreRn_maybe ) @@ -11,33 +11,21 @@ import SrcLoc ( Located(..) ) import Outputable ( ppr, defaultUserStyle ) -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 :: Maybe HsDocString -> RnM (Maybe HsDocString) rnMbHsDoc mb_doc = case mb_doc of Just doc -> do doc' <- rnHsDoc doc return (Just doc') Nothing -> return Nothing -rnMbLHsDoc :: Maybe (LHsDoc RdrName) -> RnM (Maybe (LHsDoc Name)) +rnMbLHsDoc :: Maybe LHsDocString -> RnM (Maybe LHsDocString) rnMbLHsDoc mb_doc = case mb_doc of Just doc -> do doc' <- rnLHsDoc doc return (Just doc') Nothing -> return Nothing -rnLHsDoc :: LHsDoc RdrName -> RnM (LHsDoc Name) +rnLHsDoc :: LHsDocString -> RnM LHsDocString rnLHsDoc (L pos doc) = do doc' <- rnHsDoc doc return (L pos doc') @@ -46,60 +34,6 @@ ids2string :: [RdrName] -> String ids2string [] = [] ids2string (x:_) = show $ ppr x defaultUserStyle -rnHsDoc :: HsDoc RdrName -> RnM (HsDoc Name) -rnHsDoc doc = case doc of - - DocEmpty -> return DocEmpty - - DocAppend a b -> do - a' <- rnHsDoc a - b' <- rnHsDoc b - return (DocAppend a' b') - - DocString str -> return (DocString str) - - DocParagraph doc -> do - doc' <- rnHsDoc doc - return (DocParagraph doc') - - DocIdentifier ids -> do - let choices = concatMap dataTcOccs ids - mb_gres <- mapM lookupGreRn_maybe choices - case [gre_name gre | Just gre <- mb_gres] of - [] -> return (DocString (ids2string ids)) - ids' -> return (DocIdentifier ids') - - DocModule str -> return (DocModule str) - - DocEmphasis doc -> do - doc' <- rnHsDoc doc - return (DocEmphasis doc') - - DocMonospaced doc -> do - doc' <- rnHsDoc doc - return (DocMonospaced doc') - - DocUnorderedList docs -> do - docs' <- mapM rnHsDoc docs - return (DocUnorderedList docs') - - DocOrderedList docs -> do - docs' <- mapM rnHsDoc docs - return (DocOrderedList docs') - - DocDefList list -> do - list' <- mapM (\(a,b) -> do - a' <- rnHsDoc a - b' <- rnHsDoc b - return (a', b')) list - return (DocDefList list') - - DocCodeBlock doc -> do - doc' <- rnHsDoc doc - return (DocCodeBlock doc') - - DocURL str -> return (DocURL str) - - DocPic str -> return (DocPic str) +rnHsDoc :: HsDocString -> RnM HsDocString +rnHsDoc (HsDocString s) = return (HsDocString s) - DocAName str -> return (DocAName str)