aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Utils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Utils.hs')
-rw-r--r--src/Haddock/Utils.hs103
1 files changed, 64 insertions, 39 deletions
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index 478025d8..de97ef85 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -17,7 +17,7 @@ module Haddock.Utils (
toDescription, toInstalledDescription,
-- * Filename utilities
- moduleHtmlFile,
+ moduleHtmlFile, moduleHtmlFile',
contentsHtmlFile, indexHtmlFile,
frameIndexHtmlFile,
moduleIndexFrameName, mainFrameName, synopsisFrameName,
@@ -25,7 +25,7 @@ module Haddock.Utils (
jsFile, framesFile,
-- * Anchor and URL utilities
- moduleNameUrl, moduleUrl,
+ moduleNameUrl, moduleNameUrl', moduleUrl,
nameAnchorId,
makeAnchorId,
@@ -33,7 +33,7 @@ module Haddock.Utils (
getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr,
-- * HTML cross reference mapping
- html_xrefs_ref,
+ html_xrefs_ref, html_xrefs_ref',
-- * Doc markup
markup,
@@ -172,15 +172,24 @@ restrictATs names ats = [ at | at <- ats , tcdName (unL at) `elem` names ]
--------------------------------------------------------------------------------
+baseName :: ModuleName -> FilePath
+baseName = map (\c -> if c == '.' then '-' else c) . moduleNameString
+
+
moduleHtmlFile :: Module -> FilePath
moduleHtmlFile mdl =
case Map.lookup mdl html_xrefs of
- Nothing -> mdl' ++ ".html"
- Just fp0 -> HtmlPath.joinPath [fp0, mdl' ++ ".html"]
+ Nothing -> baseName mdl' ++ ".html"
+ Just fp0 -> HtmlPath.joinPath [fp0, baseName mdl' ++ ".html"]
where
- mdl' = map (\c -> if c == '.' then '-' else c)
- (moduleNameString (moduleName mdl))
+ mdl' = moduleName mdl
+
+moduleHtmlFile' :: ModuleName -> FilePath
+moduleHtmlFile' mdl =
+ case Map.lookup mdl html_xrefs' of
+ Nothing -> baseName mdl ++ ".html"
+ Just fp0 -> HtmlPath.joinPath [fp0, baseName mdl ++ ".html"]
contentsHtmlFile, indexHtmlFile :: String
@@ -229,6 +238,10 @@ moduleNameUrl :: Module -> OccName -> String
moduleNameUrl mdl n = moduleUrl mdl ++ '#' : nameAnchorId n
+moduleNameUrl' :: ModuleName -> OccName -> String
+moduleNameUrl' mdl n = moduleHtmlFile' mdl ++ '#' : nameAnchorId n
+
+
nameAnchorId :: OccName -> String
nameAnchorId name = makeAnchorId (prefix : ':' : occNameString name)
where prefix | isValOcc name = 'v'
@@ -353,11 +366,21 @@ html_xrefs_ref :: IORef (Map Module FilePath)
html_xrefs_ref = unsafePerformIO (newIORef (error "module_map"))
+{-# NOINLINE html_xrefs_ref' #-}
+html_xrefs_ref' :: IORef (Map ModuleName FilePath)
+html_xrefs_ref' = unsafePerformIO (newIORef (error "module_map"))
+
+
{-# NOINLINE html_xrefs #-}
html_xrefs :: Map Module FilePath
html_xrefs = unsafePerformIO (readIORef html_xrefs_ref)
+{-# NOINLINE html_xrefs' #-}
+html_xrefs' :: Map ModuleName FilePath
+html_xrefs' = unsafePerformIO (readIORef html_xrefs_ref')
+
+
-----------------------------------------------------------------------------
-- * List utils
-----------------------------------------------------------------------------
@@ -380,22 +403,23 @@ spanWith p xs@(a:as)
markup :: DocMarkup id a -> Doc id -> a
-markup m DocEmpty = markupEmpty m
-markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2)
-markup m (DocString s) = markupString m s
-markup m (DocParagraph d) = markupParagraph m (markup m d)
-markup m (DocIdentifier x) = markupIdentifier m x
-markup m (DocModule mod0) = markupModule m mod0
-markup m (DocEmphasis d) = markupEmphasis m (markup m d)
-markup m (DocMonospaced d) = markupMonospaced m (markup m d)
-markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds)
-markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds)
-markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds)
-markup m (DocCodeBlock d) = markupCodeBlock m (markup m d)
-markup m (DocURL url) = markupURL m url
-markup m (DocAName ref) = markupAName m ref
-markup m (DocPic img) = markupPic m img
-markup m (DocExamples e) = markupExample m e
+markup m DocEmpty = markupEmpty m
+markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2)
+markup m (DocString s) = markupString m s
+markup m (DocParagraph d) = markupParagraph m (markup m d)
+markup m (DocIdentifier x) = markupIdentifier m x
+markup m (DocIdentifierUnchecked x) = markupIdentifierUnchecked m x
+markup m (DocModule mod0) = markupModule m mod0
+markup m (DocEmphasis d) = markupEmphasis m (markup m d)
+markup m (DocMonospaced d) = markupMonospaced m (markup m d)
+markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds)
+markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds)
+markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds)
+markup m (DocCodeBlock d) = markupCodeBlock m (markup m d)
+markup m (DocURL url) = markupURL m url
+markup m (DocAName ref) = markupAName m ref
+markup m (DocPic img) = markupPic m img
+markup m (DocExamples e) = markupExample m e
markupPair :: DocMarkup id a -> (Doc id, Doc id) -> (a, a)
@@ -405,22 +429,23 @@ markupPair m (a,b) = (markup m a, markup m b)
-- | The identity markup
idMarkup :: DocMarkup a (Doc a)
idMarkup = Markup {
- markupEmpty = DocEmpty,
- markupString = DocString,
- markupParagraph = DocParagraph,
- markupAppend = DocAppend,
- markupIdentifier = DocIdentifier,
- markupModule = DocModule,
- markupEmphasis = DocEmphasis,
- markupMonospaced = DocMonospaced,
- markupUnorderedList = DocUnorderedList,
- markupOrderedList = DocOrderedList,
- markupDefList = DocDefList,
- markupCodeBlock = DocCodeBlock,
- markupURL = DocURL,
- markupAName = DocAName,
- markupPic = DocPic,
- markupExample = DocExamples
+ markupEmpty = DocEmpty,
+ markupString = DocString,
+ markupParagraph = DocParagraph,
+ markupAppend = DocAppend,
+ markupIdentifier = DocIdentifier,
+ markupIdentifierUnchecked = DocIdentifierUnchecked,
+ markupModule = DocModule,
+ markupEmphasis = DocEmphasis,
+ markupMonospaced = DocMonospaced,
+ markupUnorderedList = DocUnorderedList,
+ markupOrderedList = DocOrderedList,
+ markupDefList = DocDefList,
+ markupCodeBlock = DocCodeBlock,
+ markupURL = DocURL,
+ markupAName = DocAName,
+ markupPic = DocPic,
+ markupExample = DocExamples
}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 11:17:34 +0000