diff options
Diffstat (limited to 'src/Haddock/Parser.hs')
-rw-r--r-- | src/Haddock/Parser.hs | 19 |
1 files changed, 15 insertions, 4 deletions
diff --git a/src/Haddock/Parser.hs b/src/Haddock/Parser.hs index b8aa9cb4..6370eecb 100644 --- a/src/Haddock/Parser.hs +++ b/src/Haddock/Parser.hs @@ -167,7 +167,7 @@ moduleName = DocModule <$> (char '"' *> modid <* char '"') -- Right (DocPic (Picture "hello.png" (Just "world"))) picture :: Parser (Doc a) picture = DocPic . makeLabeled Picture . decodeUtf8 - <$> ("<<" *> takeWhile1 (`notElem` ">\n") <* ">>") + <$> disallowNewline ("<<" *> takeUntil ">>") -- | Paragraph parser, called by 'parseParas'. paragraph :: DynFlags -> Parser (Doc RdrName) @@ -271,7 +271,8 @@ moreContent :: Monoid a => Parser a -> DynFlags -> Parser ([String], Either (Doc RdrName) a) moreContent item d = first . (:) <$> nonEmptyLine <*> more item d --- | Collects and parses the result of 'dropFrontOfPara' +-- | Runs the 'parseParas' parser on an indented paragraph. +-- The indentation is 4 spaces. indentedParagraphs :: DynFlags -> Parser (Doc RdrName) indentedParagraphs d = parseParas d . concat <$> dropFrontOfPara " " @@ -367,7 +368,9 @@ codeblock d = | otherwise = Just $ c == '\n' hyperlink :: Parser (Doc a) -hyperlink = DocHyperlink . makeLabeled Hyperlink . decodeUtf8 <$> ("<" *> takeWhile1 (`notElem` ">\n") <* ">") +hyperlink = DocHyperlink . makeLabeled Hyperlink . decodeUtf8 + <$> disallowNewline ("<" *> takeUntil ">") + <|> autoUrl autoUrl :: Parser (Doc a) autoUrl = mkLink <$> url @@ -425,6 +428,14 @@ takeHorizontalSpace :: Parser BS.ByteString takeHorizontalSpace = takeWhile (`elem` " \t\f\v\r") makeLabeled :: (String -> Maybe String -> a) -> String -> a -makeLabeled f input = case break isSpace $ strip input of +makeLabeled f input = case break isSpace $ removeEscapes $ strip input of (uri, "") -> f uri Nothing (uri, label) -> f uri (Just $ dropWhile isSpace label) + where + -- As we don't parse these any further, we don't do any processing to the + -- string so we at least remove escape character here. Perhaps we should + -- actually be parsing the label at the very least? + removeEscapes "" = "" + removeEscapes ('\\':'\\':xs) = '\\' : removeEscapes xs + removeEscapes ('\\':xs) = removeEscapes xs + removeEscapes (x:xs) = x : removeEscapes xs |