From 06517a6a4c5c6c7a89ea4ad57d85ffc458393a07 Mon Sep 17 00:00:00 2001
From: Simon Hengel <sol@typeful.net>
Date: Sun, 16 Nov 2014 08:58:40 +0800
Subject: (wip) Add support for @since (closes #26)

---
 .../src/Documentation/Haddock/Parser.hs            | 26 +++++++++++++++++-----
 1 file changed, 20 insertions(+), 6 deletions(-)

(limited to 'haddock-library/src/Documentation/Haddock/Parser.hs')

diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index c323ce0c..1cc277b8 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -78,7 +78,7 @@ overIdentifier f d = g d
     g (DocExamples x) = DocExamples x
     g (DocHeader (Header l x)) = DocHeader . Header l $ g x
 
-parse :: Parser a -> BS.ByteString -> a
+parse :: Parser a -> BS.ByteString -> (ParserState, a)
 parse p = either err id . parseOnly (p <* endOfInput)
   where
     err = error . ("Haddock.Parser.parse: " ++)
@@ -86,19 +86,27 @@ parse p = either err id . parseOnly (p <* endOfInput)
 -- | Main entry point to the parser. Appends the newline character
 -- to the input string.
 parseParas :: String -- ^ String to parse
-           -> DocH mod Identifier
-parseParas = parse (p <* skipSpace) . encodeUtf8 . (++ "\n")
+           -> (Maybe Version, DocH mod Identifier)
+parseParas input = case parseParasState input of
+  (state, a) -> (parserStateSince state, a)
+
+parseParasState :: String -> (ParserState, DocH mod Identifier)
+parseParasState = parse (p <* skipSpace) . encodeUtf8 . (++ "\n")
   where
     p :: Parser (DocH mod Identifier)
     p = docConcat <$> paragraph `sepBy` many (skipHorizontalSpace *> "\n")
 
+parseParagraphs :: String -> Parser (DocH mod Identifier)
+parseParagraphs input = case parseParasState input of
+  (state, a) -> setParserState state >> return a
+
 -- | Parse a text paragraph. Actually just a wrapper over 'parseStringBS' which
 -- drops leading whitespace and encodes the string to UTF8 first.
 parseString :: String -> DocH mod Identifier
 parseString = parseStringBS . encodeUtf8 . dropWhile isSpace
 
 parseStringBS :: BS.ByteString -> DocH mod Identifier
-parseStringBS = parse p
+parseStringBS = snd . parse p
   where
     p :: Parser (DocH mod Identifier)
     p = docConcat <$> many (monospace <|> anchor <|> identifier <|> moduleName
@@ -217,7 +225,8 @@ markdownImage = fromHyperlink <$> ("!" *> linkParser)
 -- | Paragraph parser, called by 'parseParas'.
 paragraph :: Parser (DocH mod Identifier)
 paragraph = examples <|> skipSpace *> (
-      unorderedList
+      since
+  <|> unorderedList
   <|> orderedList
   <|> birdtracks
   <|> codeblock
@@ -228,6 +237,11 @@ paragraph = examples <|> skipSpace *> (
   <|> docParagraph <$> textParagraph
   )
 
+since :: Parser (DocH mod a)
+since = ("@since " *> version <* skipHorizontalSpace <* endOfLine) >>= setSince >> return DocEmpty
+  where
+    version = decimal `sepBy1'` "."
+
 -- | Headers inside the comment denoted with @=@ signs, up to 6 levels
 -- deep.
 --
@@ -334,7 +348,7 @@ moreContent item = first . (:) <$> nonEmptyLine <*> more item
 -- | Parses an indented paragraph.
 -- The indentation is 4 spaces.
 indentedParagraphs :: Parser (DocH mod Identifier)
-indentedParagraphs = parseParas . concat <$> dropFrontOfPara "    "
+indentedParagraphs = (concat <$> dropFrontOfPara "    ") >>= parseParagraphs
 
 -- | Grab as many fully indented paragraphs as we can.
 dropFrontOfPara :: Parser BS.ByteString -> Parser [String]
-- 
cgit v1.2.3