[commit: haddock] T6018-injective-type-families, adamse-D1033, ghc-head, master, metainfo, wip/10268, wip/10313, wip/D538, wip/D538-1, wip/D538-2, wip/D538-3, wip/D538-4, wip/D538-5, wip/D538-6, wip/D548-master, wip/D548-master-2, wip/T10483, wip/T9840, wip/api-annot-tweaks-7.10, wip/api-annots-ghc-7.10-3, wip/orf-reboot: Allow markdown links at the beginning of a paragraph (58a5683)

git at git.haskell.org git at git.haskell.org
Wed Jul 8 08:32:26 UTC 2015


Repository : ssh://git@git.haskell.org/haddock

On branches: T6018-injective-type-families,adamse-D1033,ghc-head,master,metainfo,wip/10268,wip/10313,wip/D538,wip/D538-1,wip/D538-2,wip/D538-3,wip/D538-4,wip/D538-5,wip/D538-6,wip/D548-master,wip/D548-master-2,wip/T10483,wip/T9840,wip/api-annot-tweaks-7.10,wip/api-annots-ghc-7.10-3,wip/orf-reboot
Link       : http://git.haskell.org/haddock.git/commitdiff/58a5683d1ce759f80ca7eb3b35663b717ae2abd5

>---------------------------------------------------------------

commit 58a5683d1ce759f80ca7eb3b35663b717ae2abd5
Author: Simon Hengel <sol at typeful.net>
Date:   Sun Nov 2 12:07:24 2014 +0800

    Allow markdown links at the beginning of a paragraph


>---------------------------------------------------------------

58a5683d1ce759f80ca7eb3b35663b717ae2abd5
 .../src/Documentation/Haddock/Parser.hs            | 20 ++++++++++++++--
 .../test/Documentation/Haddock/ParserSpec.hs       | 28 +++++++++++++++++++---
 2 files changed, 43 insertions(+), 5 deletions(-)

diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index e53597e..f1fd5dd 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      :  Documentation.Haddock.Parser
 -- Copyright   :  (c) Mateusz Kowalczyk 2013-2014,
@@ -217,8 +218,9 @@ paragraph = examples <|> skipSpace *> (
   <|> codeblock
   <|> property
   <|> header
+  <|> textParagraphThatStartsWithMarkdownLink
   <|> definitionList
-  <|> textParagraph
+  <|> docParagraph <$> textParagraph
   )
 
 -- | Headers inside the comment denoted with @=@ signs, up to 6 levels
@@ -238,7 +240,21 @@ header = do
   return $ DocHeader (Header (length delim) line) `docAppend` rest
 
 textParagraph :: Parser (DocH mod Identifier)
-textParagraph = docParagraph . parseString . intercalate "\n" <$> many1 nonEmptyLine
+textParagraph = parseString . intercalate "\n" <$> many1 nonEmptyLine
+
+textParagraphThatStartsWithMarkdownLink :: Parser (DocH mod Identifier)
+textParagraphThatStartsWithMarkdownLink = docParagraph <$> (docAppend <$> markdownLink <*> optionalTextParagraph)
+  where
+    optionalTextParagraph :: Parser (DocH mod Identifier)
+    optionalTextParagraph = (docAppend <$> whitespace <*> textParagraph) <|> pure DocEmpty
+
+    whitespace :: Parser (DocH mod a)
+    whitespace = DocString <$> (f <$> takeHorizontalSpace <*> optional "\n")
+      where
+        f :: BS.ByteString -> Maybe BS.ByteString -> String
+        f xs (fromMaybe "" -> x)
+          | BS.null (xs <> x) = ""
+          | otherwise = " "
 
 -- | Parses unordered (bullet) lists.
 unorderedList :: Parser (DocH mod Identifier)
diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs
index cb417cf..6d152ee 100644
--- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs
+++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs
@@ -28,6 +28,9 @@ parseParas = Parse.toRegular . Parse.parseParas
 parseString :: String -> Doc String
 parseString = Parse.toRegular . Parse.parseString
 
+hyperlink :: String -> Maybe String -> Doc String
+hyperlink url = DocHyperlink . Hyperlink url
+
 main :: IO ()
 main = hspec spec
 
@@ -83,9 +86,6 @@ spec = do
           "don't use apostrophe's in the wrong place's"
 
     context "when parsing URLs" $ do
-      let hyperlink :: String -> Maybe String -> Doc String
-          hyperlink url = DocHyperlink . Hyperlink url
-
       it "parses a URL" $ do
         "<http://example.com/>" `shouldParseTo` hyperlink "http://example.com/" Nothing
 
@@ -387,6 +387,28 @@ spec = do
         it "turns it into a code block" $ do
           "@foo@" `shouldParseTo` DocCodeBlock "foo"
 
+      context "when a paragraph starts with a markdown link" $ do
+        it "correctly parses it as a text paragraph (not a definition list)" $ do
+          "[label](url)" `shouldParseTo`
+            DocParagraph (hyperlink "url" "label")
+
+        it "can be followed by an other paragraph" $ do
+          "[label](url)\n\nfoobar" `shouldParseTo`
+            DocParagraph (hyperlink "url" "label") <> DocParagraph "foobar"
+
+        context "when paragraph contains additional text" $ do
+          it "accepts more text after the link" $ do
+            "[label](url) foo bar baz" `shouldParseTo`
+              DocParagraph (hyperlink "url" "label" <> " foo bar baz")
+
+          it "accepts a newline right after the markdown link" $ do
+            "[label](url)\nfoo bar baz" `shouldParseTo`
+              DocParagraph (hyperlink "url" "label" <> " foo bar baz")
+
+          it "can be followed by an other paragraph" $ do
+            "[label](url)foo\n\nbar" `shouldParseTo`
+              DocParagraph (hyperlink "url" "label" <> "foo") <> DocParagraph "bar"
+
     context "when parsing birdtracks" $ do
       it "parses them as a code block" $ do
         unlines [



More information about the ghc-commits mailing list