X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnHsDoc.hs;h=beb45bbfbcb605580cf3c79807ca4cca5ea06b79;hp=f3d36907f4e4534b564676992670c145ddbcd574;hb=16b9e80dc14db24509f051f294b5b51943285090;hpb=5ad61e1470db6dbc8279569c5ad1cc093f753ac0 diff --git a/compiler/rename/RnHsDoc.hs b/compiler/rename/RnHsDoc.hs index f3d3690..beb45bb 100644 --- a/compiler/rename/RnHsDoc.hs +++ b/compiler/rename/RnHsDoc.hs @@ -1,88 +1,23 @@ -module RnHsDoc ( rnHsDoc, rnLHsDoc, rnMbLHsDoc, rnMbHsDoc ) where -import TcRnMonad ( RnM ) -import RnEnv ( dataTcOccs, lookupGreRn_maybe ) -import HsDoc ( HsDoc(..) ) +module RnHsDoc ( rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where -import RdrName ( RdrName, isRdrDataCon, isRdrTc, gre_name ) -import Name ( Name ) +import TcRnTypes +import HsSyn import SrcLoc ( Located(..) ) -import Outputable ( ppr, defaultUserStyle ) -import Data.List ( (\\) ) -import Debug.Trace ( trace ) - -rnMbHsDoc mb_doc = case mb_doc of - Just doc -> do - doc' <- rnHsDoc doc - return (Just doc') - Nothing -> return Nothing +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 :: LHsDocString -> RnM LHsDocString rnLHsDoc (L pos doc) = do doc' <- rnHsDoc doc return (L pos doc') -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) +rnHsDoc :: HsDocString -> RnM HsDocString +rnHsDoc (HsDocString s) = return (HsDocString s) - DocAName str -> return (DocAName str)