X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnHsDoc.hs;h=9e53f4932016a756a5c686c691d15cea071425f6;hp=6941da59c162a1dc6270d2fbfd72b75051aaf136;hb=b2bd63f99d643f6b3eb30bb72bb9ae26d4183252;hpb=190f24892156953d73b55401d0467a6f1a88ce5d diff --git a/compiler/rename/RnHsDoc.hs b/compiler/rename/RnHsDoc.hs index 6941da5..9e53f49 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 ) -import HsDoc ( HsDoc(..) ) +module RnHsDoc ( rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where -import RdrName ( RdrName, isRdrDataCon, isRdrTc, gre_name ) -import Name ( Name ) -import SrcLoc ( Located(..) ) -import Outputable ( ppr, defaultUserStyle ) +import TcRnTypes +import HsSyn +import SrcLoc -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 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)