From ef9aa98d6ccbe79888c501f94c9aa6688520c28e Mon Sep 17 00:00:00 2001
From: Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>
Date: Fri, 10 Jan 2014 05:37:17 +0000
Subject: Support for bold.

Conflicts:
	src/Haddock/Backends/Hoogle.hs
	src/Haddock/Interface/Rename.hs
	src/Haddock/Parser.hs
---
 src/Haddock/Parser.hs | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

(limited to 'src/Haddock/Parser.hs')

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_
-- 
cgit v1.2.3