diff options
| -rw-r--r-- | CHANGES | 2 | ||||
| -rw-r--r-- | doc/haddock.xml | 7 | ||||
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Parser.hs | 11 | ||||
| -rw-r--r-- | haddock-library/test/Documentation/Haddock/ParserSpec.hs | 13 | ||||
| -rw-r--r-- | html-test/ref/Bug308.html | 111 | ||||
| -rw-r--r-- | html-test/ref/Bug308CrossModule.html | 91 | ||||
| -rw-r--r-- | html-test/src/Bug308.hs | 21 | ||||
| -rw-r--r-- | html-test/src/Bug308CrossModule.hs | 17 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/DocMarkup.hs | 7 |
9 files changed, 274 insertions, 6 deletions
@@ -6,6 +6,8 @@ Changes in version 2.14.3 * Fix parsing of identifiers with ^ or ⋆ in them (#298) + * Fix anchors (#308) + Changes in version 2.14.2 * Always drop --split-objs GHC flag for performance reasons (#292) diff --git a/doc/haddock.xml b/doc/haddock.xml index 1eaa7f02..39a947ca 100644 --- a/doc/haddock.xml +++ b/doc/haddock.xml @@ -2106,8 +2106,11 @@ This belongs to the list above! <literal>"<replaceable>module</replaceable>#<replaceable>label</replaceable>"</literal> where <replaceable>module</replaceable> is the module name containing the anchor, and <replaceable>label</replaceable> is - the anchor label. The module does not have to be local, it - can be imported via an interface.</para> + the anchor label. The module does not have to be local, it can + be imported via an interface. Please note that in Haddock + versions 2.13.x and earlier, the syntax was + <literal>"<replaceable>module</replaceable>\#<replaceable>label</replaceable>"</literal>. + It is considered deprecated and will be removed in the future.</para> </section> <section> diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index 37bf4ca7..f13cedc6 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -121,8 +121,11 @@ encodedChar = "&#" *> c <* ";" num = hex <|> decimal hex = ("x" <|> "X") *> hexadecimal +-- | List of characters that we use to delimit any special markup. +-- Once we have checked for any of these and tried to parse the +-- relevant markup, we can assume they are used as regular text. specialChar :: [Char] -specialChar = "_/<@\"&'`" +specialChar = "_/<@\"&'`#" -- | Plain, regular parser for text. Called as one of the last parsers -- to ensure that we have already given a chance to more meaningful parsers @@ -176,7 +179,8 @@ takeWhile1_ = mfilter (not . BS.null) . takeWhile_ -- >>> parseOnly anchor "#Hello world#" -- Right (DocAName "Hello world") anchor :: Parser (DocH mod a) -anchor = DocAName . decodeUtf8 <$> ("#" *> takeWhile1 (`notElem` "#\n") <* "#") +anchor = DocAName . decodeUtf8 <$> + disallowNewline ("#" *> takeWhile1_ (/= '#') <* "#") -- | Monospaced strings. -- @@ -194,7 +198,8 @@ moduleName = DocModule <$> (char '"' *> modid <* char '"') -- NOTE: According to Haskell 2010 we should actually only -- accept {small | large | digit | ' } here. But as we can't -- match on unicode characters, this is currently not possible. - <*> (decodeUtf8 <$> takeWhile (`notElem` " .&[{}(=*)+]!#|@/;,^?\"\n")) + -- Note that we allow ‘#’ to suport anchors. + <*> (decodeUtf8 <$> takeWhile (`notElem` " .&[{}(=*)+]!|@/;,^?\"\n")) -- | Picture parser, surrounded by \<\< and \>\>. It's possible to specify -- a title for the picture. diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs index 8e73848d..4bcbbec7 100644 --- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs +++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs @@ -169,6 +169,13 @@ spec = do it "does not accept newlines in anchors" $ do "#foo\nbar#" `shouldParseTo` "#foo\nbar#" + it "accepts anchors mid-paragraph" $ do + "Hello #someAnchor# world!" + `shouldParseTo` "Hello " <> DocAName "someAnchor" <> " world!" + + it "does not accept empty anchors" $ do + "##" `shouldParseTo` "##" + context "when parsing emphasised text" $ do it "emphasises a word on its own" $ do "/foo/" `shouldParseTo` DocEmphasis "foo" @@ -292,6 +299,12 @@ spec = do it "treats empty module name as regular double quotes" $ do "\"\"" `shouldParseTo` "\"\"" + it "accepts anchor reference syntax as DocModule" $ do + "\"Foo#bar\"" `shouldParseTo` DocModule "Foo#bar" + + it "accepts old anchor reference syntax as DocModule" $ do + "\"Foo\\#bar\"" `shouldParseTo` DocModule "Foo\\#bar" + describe "parseParas" $ do let infix 1 `shouldParseTo` shouldParseTo :: String -> Doc String -> Expectation diff --git a/html-test/ref/Bug308.html b/html-test/ref/Bug308.html new file mode 100644 index 00000000..517a1cd9 --- /dev/null +++ b/html-test/ref/Bug308.html @@ -0,0 +1,111 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><title + >Bug308</title + ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean" + /><script src="haddock-util.js" type="text/javascript" + ></script + ><script type="text/javascript" + >//<![CDATA[ +window.onload = function () {pageLoad();setSynopsis("mini_Bug308.html");}; +//]]> +</script + ></head + ><body + ><div id="package-header" + ><ul class="links" id="page-menu" + ><li + ><a href="" + >Contents</a + ></li + ><li + ><a href="" + >Index</a + ></li + ></ul + ><p class="caption empty" + > </p + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >Safe-Inferred</td + ></tr + ></table + ><p class="caption" + >Bug308</p + ></div + ><div id="synopsis" + ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')" + >Synopsis</p + ><ul id="section.syn" class="hide" onclick="toggleSection('syn')" + ><li class="src short" + ><a href="" + >f</a + > :: ()</li + ><li class="src short" + ><a href="" + >g</a + > :: ()</li + ></ul + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><a name="v:f" class="def" + >f</a + > :: ()</p + ><div class="doc" + ><p + >start<a name="startAnchor" + ></a + > followed by middle<a name="middleAnchor" + ></a + > and end<a name="endAnchor" + ></a + ></p + ></div + ></div + ><div class="top" + ><p class="src" + ><a name="v:g" class="def" + >g</a + > :: ()</p + ><div class="doc" + ><p + >start <a href="" + >Bug308</a + ></p + ><p + >startOldStyle <a href="" + >Bug308</a + ></p + ><p + >middle <a href="" + >Bug308</a + ></p + ><p + >end <a href="" + >Bug308</a + ></p + ></div + ></div + ></div + ></div + ><div id="footer" + ><p + >Produced by <a href="" + >Haddock</a + > version 2.15.0</p + ></div + ></body + ></html +> diff --git a/html-test/ref/Bug308CrossModule.html b/html-test/ref/Bug308CrossModule.html new file mode 100644 index 00000000..6a053d3c --- /dev/null +++ b/html-test/ref/Bug308CrossModule.html @@ -0,0 +1,91 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><title + >Bug308CrossModule</title + ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean" + /><script src="haddock-util.js" type="text/javascript" + ></script + ><script type="text/javascript" + >//<![CDATA[ +window.onload = function () {pageLoad();setSynopsis("mini_Bug308CrossModule.html");}; +//]]> +</script + ></head + ><body + ><div id="package-header" + ><ul class="links" id="page-menu" + ><li + ><a href="" + >Contents</a + ></li + ><li + ><a href="" + >Index</a + ></li + ></ul + ><p class="caption empty" + > </p + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >Safe-Inferred</td + ></tr + ></table + ><p class="caption" + >Bug308CrossModule</p + ></div + ><div id="synopsis" + ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')" + >Synopsis</p + ><ul id="section.syn" class="hide" onclick="toggleSection('syn')" + ><li class="src short" + ><a href="" + >h</a + > :: ()</li + ></ul + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><a name="v:h" class="def" + >h</a + > :: ()</p + ><div class="doc" + ><p + >start <a href="" + >Bug308</a + ></p + ><p + >startOldStyle <a href="" + >Bug308</a + ></p + ><p + >middle <a href="" + >Bug308</a + ></p + ><p + >end <a href="" + >Bug308</a + ></p + ></div + ></div + ></div + ></div + ><div id="footer" + ><p + >Produced by <a href="" + >Haddock</a + > version 2.15.0</p + ></div + ></body + ></html +> diff --git a/html-test/src/Bug308.hs b/html-test/src/Bug308.hs new file mode 100644 index 00000000..3adb3746 --- /dev/null +++ b/html-test/src/Bug308.hs @@ -0,0 +1,21 @@ +-- From 2.14.x onwards we were forgetting to swallow ‘#’ as a special +-- character resulting in broken anchors if they accured +-- mid-paragraph. Here we check that anchors get generated as +-- expected. +module Bug308 where + +-- | start#startAnchor# followed by middle#middleAnchor# and end#endAnchor# +f :: () +f = () + +{-| +start "Bug308#startAnchor" + +startOldStyle "Bug308\#startAnchor" + +middle "Bug308#middleAnchor" + +end "Bug308#middleAnchor" +-} +g :: () +g = () diff --git a/html-test/src/Bug308CrossModule.hs b/html-test/src/Bug308CrossModule.hs new file mode 100644 index 00000000..589aa69e --- /dev/null +++ b/html-test/src/Bug308CrossModule.hs @@ -0,0 +1,17 @@ +-- Just like Bug308 module but here we test that referring to anchors +-- from other modules works. +module Bug308CrossModule where + +import Bug308 + +{-| +start "Bug308#startAnchor" + +startOldStyle "Bug308\#startAnchor" + +middle "Bug308#middleAnchor" + +end "Bug308#middleAnchor" +-} +h :: () +h = () diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs index 16d771ca..5e27d9b0 100644 --- a/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -42,7 +42,12 @@ parHtmlMarkup qual insertAnchors ppId = Markup { markupIdentifier = thecode . ppId insertAnchors, markupIdentifierUnchecked = thecode . ppUncheckedLink qual, markupModule = \m -> let (mdl,ref) = break (=='#') m - in ppModuleRef (mkModuleName mdl) ref, + -- Accomodate for old style + -- foo\#bar anchors + mdl' = case reverse mdl of + '\\':_ -> init mdl + _ -> mdl + in ppModuleRef (mkModuleName mdl') ref, markupWarning = thediv ! [theclass "warning"], markupEmphasis = emphasize, markupBold = strong, |