aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Interface/Rn.hs
diff options
context:
space:
mode:
authorIsaac Dupree <id@isaac.cedarswampstudios.org>2009-08-23 03:08:03 +0000
committerIsaac Dupree <id@isaac.cedarswampstudios.org>2009-08-23 03:08:03 +0000
commit70945271f1f4deab363c1acfef3ce51a1b7f617d (patch)
tree81d518f2ca4dde1a1c72072b8a67290de2952388 /src/Haddock/Interface/Rn.hs
parent9dc98d20af5bbcb8bff7624b3d8c4d840ed6bb4e (diff)
Move doc parsing/lexing into Haddock for ghc>=6.11
Diffstat (limited to 'src/Haddock/Interface/Rn.hs')
-rw-r--r--src/Haddock/Interface/Rn.hs82
1 files changed, 82 insertions, 0 deletions
diff --git a/src/Haddock/Interface/Rn.hs b/src/Haddock/Interface/Rn.hs
new file mode 100644
index 00000000..c45b5042
--- /dev/null
+++ b/src/Haddock/Interface/Rn.hs
@@ -0,0 +1,82 @@
+
+module Haddock.Interface.Rn ( rnHsDoc, rnHaddockModInfo ) where
+
+import Haddock.Types
+
+import RnEnv ( dataTcOccs )
+
+import RdrName ( RdrName, gre_name, GlobalRdrEnv, lookupGRE_RdrName )
+import Name ( Name )
+import Outputable ( ppr, defaultUserStyle )
+
+rnHaddockModInfo :: GlobalRdrEnv -> HaddockModInfo RdrName -> HaddockModInfo Name
+rnHaddockModInfo gre (HaddockModInfo desc port stab maint) =
+ HaddockModInfo (fmap (rnHsDoc gre) desc) port stab maint
+
+ids2string :: [RdrName] -> String
+ids2string [] = []
+ids2string (x:_) = show $ ppr x defaultUserStyle
+
+data Id x = Id {unId::x}
+instance Monad Id where (Id v)>>=f = f v; return = Id
+
+rnHsDoc :: GlobalRdrEnv -> HsDoc RdrName -> HsDoc Name
+rnHsDoc 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 ids -> do
+ let choices = concatMap dataTcOccs ids
+ let gres = concatMap (\rdrName ->
+ map gre_name (lookupGRE_RdrName rdrName gre)) choices
+ case gres of
+ [] -> return (DocString (ids2string ids))
+ ids' -> return (DocIdentifier ids')
+
+ 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)