aboutsummaryrefslogtreecommitdiff
path: root/haddock-library
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-library')
-rw-r--r--haddock-library/src/Documentation/Haddock/Parser.hs11
-rw-r--r--haddock-library/test/Documentation/Haddock/ParserSpec.hs13
2 files changed, 21 insertions, 3 deletions
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