aboutsummaryrefslogtreecommitdiff
path: root/src/HaddockUtil.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/HaddockUtil.hs')
-rw-r--r--src/HaddockUtil.hs26
1 files changed, 22 insertions, 4 deletions
diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs
index 27a83770..633fc36f 100644
--- a/src/HaddockUtil.hs
+++ b/src/HaddockUtil.hs
@@ -16,12 +16,15 @@ module HaddockUtil (
isPathSeparator, pathSeparator,
-- * Miscellaneous utilities
- die, dieMsg, mapSnd, mapMaybeM
+ die, dieMsg, mapSnd, mapMaybeM,
+ -- * HTML cross reference mapping
+ html_xrefs_ref, html_xrefs,
) where
import HsSyn
+import FiniteMap
import List ( intersect )
import IO ( hPutStr, stderr )
import System
@@ -70,9 +73,6 @@ conDeclBinders (HsRecDecl _ n _ _ fields _) =
fieldDeclBinders (HsFieldDecl ns _ _) = ns
-exQtNm (HsForAllType _ _ t) = nameOfQName (fst (splitTyConApp t))
-exQtNm t = nameOfQName (fst (splitTyConApp t))
-
splitTyConApp :: HsType -> (HsQName, [HsType])
splitTyConApp t = split t []
where
@@ -223,6 +223,24 @@ mapMaybeM f Nothing = return Nothing
mapMaybeM f (Just a) = f a >>= return . Just
-----------------------------------------------------------------------------
+-- HTML cross references
+
+-- For each module, we need to know where its HTML documentation lives
+-- so that we can point hyperlinks to it. It is extremely
+-- inconvenient to plumb this information to all the places that need
+-- it (basically every function in HaddockHtml), and furthermore the
+-- mapping is constant for any single run of Haddock. So for the time
+-- being I'm going to use a write-once global variable.
+
+{-# NOINLINE html_xrefs_ref #-}
+html_xrefs_ref :: IORef (FiniteMap Module FilePath)
+html_xrefs_ref = unsafePerformIO (newIORef (error "module_map"))
+
+{-# NOINLINE html_xrefs #-}
+html_xrefs :: FiniteMap Module FilePath
+html_xrefs = unsafePerformIO (readIORef html_xrefs_ref)
+
+-----------------------------------------------------------------------------
-- Binary instances for stuff
instance Binary Module where