diff options
Diffstat (limited to 'src/Haddock/Interface/Rn.hs')
-rw-r--r-- | src/Haddock/Interface/Rn.hs | 100 |
1 files changed, 0 insertions, 100 deletions
diff --git a/src/Haddock/Interface/Rn.hs b/src/Haddock/Interface/Rn.hs deleted file mode 100644 index 0b5efe4b..00000000 --- a/src/Haddock/Interface/Rn.hs +++ /dev/null @@ -1,100 +0,0 @@ -module Haddock.Interface.Rn ( rnDoc, rnHaddockModInfo ) where - -import Haddock.Types - -import RnEnv ( dataTcOccs ) - -import RdrName -import Name ( Name, isTyConName ) -import Outputable ( ppr, showSDoc ) - -rnHaddockModInfo :: GlobalRdrEnv -> HaddockModInfo RdrName -> HaddockModInfo Name -rnHaddockModInfo gre hmod = - let desc = hmi_description hmod - in hmod { hmi_description = fmap (rnDoc gre) desc } - -data Id x = Id {unId::x} -instance Monad Id where (Id v)>>=f = f v; return = Id - -rnDoc :: GlobalRdrEnv -> Doc RdrName -> Doc Name -rnDoc gre = unId . do_rn - where - do_rn doc_to_rn = case doc_to_rn of - - DocEmpty -> return DocEmpty - - DocAppend a b -> do - a' <- do_rn a - b' <- do_rn b - return (DocAppend a' b') - - DocString str -> return (DocString str) - - DocParagraph doc -> do - doc' <- do_rn doc - return (DocParagraph doc') - - DocIdentifier x -> do - let choices = dataTcOccs x - let names = concatMap (\c -> map gre_name (lookupGRE_RdrName c gre)) choices - return $ - case names of - [] -> - case choices of - [] -> DocMonospaced (DocString (showSDoc $ ppr x)) - [a] -> outOfScope a - a:b:_ | isRdrTc a -> outOfScope a | otherwise -> outOfScope b - [a] -> DocIdentifier a - a:b:_ | isTyConName a -> DocIdentifier a | otherwise -> DocIdentifier b - -- If an id can refer to multiple things, we give precedence to type - -- constructors. - - DocIdentifierUnchecked x -> return (DocIdentifierUnchecked x) - - DocModule str -> return (DocModule str) - - DocEmphasis doc -> do - doc' <- do_rn doc - return (DocEmphasis doc') - - DocMonospaced doc -> do - doc' <- do_rn doc - return (DocMonospaced doc') - - DocUnorderedList docs -> do - docs' <- mapM do_rn docs - return (DocUnorderedList docs') - - DocOrderedList docs -> do - docs' <- mapM do_rn docs - return (DocOrderedList docs') - - DocDefList list -> do - list' <- mapM (\(a,b) -> do - a' <- do_rn a - b' <- do_rn b - return (a', b')) list - return (DocDefList list') - - DocCodeBlock doc -> do - doc' <- do_rn doc - return (DocCodeBlock doc') - - DocURL str -> return (DocURL str) - - DocPic str -> return (DocPic str) - - DocAName str -> return (DocAName str) - - DocExamples e -> return (DocExamples e) - - -outOfScope :: RdrName -> Doc a -outOfScope x = - case x of - Unqual occ -> monospaced occ - Qual mdl occ -> DocIdentifierUnchecked (mdl, occ) - Orig _ occ -> monospaced occ - Exact name -> monospaced name -- Shouldn't happen since x is out of scope - where - monospaced a = DocMonospaced (DocString (showSDoc $ ppr a)) |