aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Parser.hs
diff options
context:
space:
mode:
authorMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2014-01-10 05:37:17 +0000
committerAustin Seipp <austin@well-typed.com>2014-01-12 14:48:35 -0600
commitef9aa98d6ccbe79888c501f94c9aa6688520c28e (patch)
treec8b86e469383ebcac5472300608355d410e6942a /src/Haddock/Parser.hs
parentd08865e42e7b03348549b79cdc251f444516bc34 (diff)
Support for bold.
Conflicts: src/Haddock/Backends/Hoogle.hs src/Haddock/Interface/Rename.hs src/Haddock/Parser.hs
Diffstat (limited to 'src/Haddock/Parser.hs')
-rw-r--r--src/Haddock/Parser.hs15
1 files changed, 13 insertions, 2 deletions
diff --git a/src/Haddock/Parser.hs b/src/Haddock/Parser.hs
index fe8904d4..58d047f7 100644
--- a/src/Haddock/Parser.hs
+++ b/src/Haddock/Parser.hs
@@ -30,6 +30,7 @@ import RdrName
import SrcLoc (mkRealSrcLoc, unLoc)
import StringBuffer (stringToStringBuffer)
import Haddock.Utf8
+import Haddock.Parser.Util
{-# DEPRECATED parseParasMaybe "use `parseParas` instead" #-}
parseParasMaybe :: DynFlags -> String -> Maybe (Doc RdrName)
@@ -63,7 +64,7 @@ parseStringBS d = parse p
where
p :: Parser (Doc RdrName)
p = mconcat <$> many (monospace d <|> anchor <|> identifier d
- <|> moduleName <|> picture <|> hyperlink <|> autoUrl
+ <|> moduleName <|> picture <|> hyperlink <|> autoUrl <|> bold d
<|> emphasis d <|> encodedChar <|> string' <|> skipSpecialChar)
-- | Parses and processes
@@ -79,7 +80,7 @@ encodedChar = "&#" *> c <* ";"
hex = ("x" <|> "X") *> hexadecimal
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
@@ -105,6 +106,16 @@ emphasis :: DynFlags -> Parser (Doc RdrName)
emphasis d = DocEmphasis . parseStringBS d <$>
mfilter ('\n' `BS.notElem`) ("/" *> takeWhile1_ (/= '/') <* "/")
+-- | Bold parser.
+--
+-- >>> parseOnly bold "__Hello world__"
+-- Right (DocBold (DocString "Hello world"))
+bold :: DynFlags -> Parser (Doc RdrName)
+bold d = DocBold . parseStringBS d <$> disallowNewline ("__" *> takeUntil "__")
+
+disallowNewline :: Parser BS.ByteString -> Parser BS.ByteString
+disallowNewline = mfilter ('\n' `BS.notElem`)
+
-- | Like `takeWhile`, but unconditionally take escaped characters.
takeWhile_ :: (Char -> Bool) -> Parser BS.ByteString
takeWhile_ p = scan False p_