Fix anchors. Closes #308.

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