aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Interface/Rn.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Interface/Rn.hs')
-rw-r--r--src/Haddock/Interface/Rn.hs100
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))