[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: Add support for markdown images (af85d14)

[git at git.haskell.org]

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/af85d14f001cf4c2976ee659ec04101d6b054a4d

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

commit af85d14f001cf4c2976ee659ec04101d6b054a4d
Author: Simon Hengel <sol at typeful.net>
Date:   Sun Nov 2 13:54:19 2014 +0800

    Add support for markdown images


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

af85d14f001cf4c2976ee659ec04101d6b054a4d
 CHANGES                                            |  2 ++
 doc/haddock.xml                                    | 19 +++++++++--------
 .../src/Documentation/Haddock/Parser.hs            | 12 +++++++++--
 .../test/Documentation/Haddock/ParserSpec.hs       | 24 ++++++++++------------
 4 files changed, 34 insertions(+), 23 deletions(-)

diff --git a/CHANGES b/CHANGES
index 009d63f..4bfe492 100644
--- a/CHANGES
+++ b/CHANGES
@@ -2,6 +2,8 @@ Changes in version 2.15.1
 
  * Experimental collapsible header support (#335)
 
+ * Add support for markdown links and images
+
 Changes in version 2.15.0
 
  * Always read in prologue files as UTF8 (#286 and Cabal #1721)
diff --git a/doc/haddock.xml b/doc/haddock.xml
index 1fece5b..ee77ede 100644
--- a/doc/haddock.xml
+++ b/doc/haddock.xml
@@ -2118,17 +2118,20 @@ This belongs to the list above!
 
       <section>
         <title>Images</title>
+        <para>
+            Haddock supports Markdown syntax for inline images.  This resembles
+            the syntax for links, but starts with an exclamation mark.  An
+            example looks like this:
+        </para>
 
-        <para>An image can be included in a documentation comment by
-        surrounding it in double angle brackets:
-        <literal><<...>></literal>.  If the output format supports
-        it, the image will be rendered inside the documentation.</para>
-
-        <para>Title text can be included using an optional label:</para>
 <programlisting>
-<<pathtoimage.png title>>
+![image description](pathtoimage.png)
 </programlisting>
-
+        <para>
+          If the output format supports it, the image will be rendered inside
+          the documentation.  The image description is used as relpacement text
+          and/or image title.
+        </para>
       </section>
 
       <section>
diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index f1fd5dd..ff03c7b 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -102,7 +102,7 @@ parseStringBS = parse p
   where
     p :: Parser (DocH mod Identifier)
     p = docConcat <$> many (monospace <|> anchor <|> identifier <|> moduleName
-                            <|> picture <|> hyperlink <|> bold
+                            <|> picture <|> markdownImage <|> hyperlink <|> bold
                             <|> emphasis <|> encodedChar <|> string'
                             <|> skipSpecialChar)
 
@@ -209,6 +209,11 @@ picture :: Parser (DocH mod a)
 picture = DocPic . makeLabeled Picture . decodeUtf8
           <$> disallowNewline ("<<" *> takeUntil ">>")
 
+markdownImage :: Parser (DocH mod a)
+markdownImage = fromHyperlink <$> ("!" *> linkParser)
+  where
+    fromHyperlink (Hyperlink url label) = DocPic (Picture url label)
+
 -- | Paragraph parser, called by 'parseParas'.
 paragraph :: Parser (DocH mod Identifier)
 paragraph = examples <|> skipSpace *> (
@@ -467,7 +472,10 @@ hyperlink = DocHyperlink . makeLabeled Hyperlink . decodeUtf8
             <|> markdownLink
 
 markdownLink :: Parser (DocH mod a)
-markdownLink = DocHyperlink <$> (flip Hyperlink <$> label <*> (whitespace *> url))
+markdownLink = DocHyperlink <$> linkParser
+
+linkParser :: Parser Hyperlink
+linkParser = flip Hyperlink <$> label <*> (whitespace *> url)
   where
     label :: Parser (Maybe String)
     label = Just . strip . decode <$> ("[" *> takeUntil "]")
diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs
index 6d152ee..4373234 100644
--- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs
+++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs
@@ -183,24 +183,22 @@ spec = do
           "foo https://example.com/example bar" `shouldParseTo`
             "foo " <> hyperlink "https://example.com/example" Nothing <> " bar"
 
-    context "when parsing pictures" $ do
-      let picture :: String -> Maybe String -> Doc String
-          picture uri = DocPic . Picture uri
+    context "when parsing images" $ do
+      let image :: String -> Maybe String -> Doc String
+          image uri = DocPic . Picture uri
 
-      it "parses a simple picture" $ do
-        "<<baz>>" `shouldParseTo` picture "baz" Nothing
+      it "accepts markdown syntax for images" $ do
+        "![label](url)" `shouldParseTo` image "url" "label"
 
-      it "parses a picture with a title" $ do
-        "<<b a z>>" `shouldParseTo` picture "b" (Just "a z")
+      it "accepts Unicode" $ do
+        "![灼眼のシャナ](url)" `shouldParseTo` image "url" "灼眼のシャナ"
 
-      it "parses a picture with unicode" $ do
-        "<<灼眼のシャナ>>" `shouldParseTo` picture "灼眼のシャナ" Nothing
+      it "supports deprecated picture syntax" $ do
+        "<<baz>>" `shouldParseTo` image "baz" Nothing
 
-      it "allows for escaping of the closing tags" $ do
-        "<<ba\\>>z>>" `shouldParseTo` picture "ba>>z" Nothing
+      it "supports title for deprecated picture syntax" $ do
+        "<<b a z>>" `shouldParseTo` image "b" "a z"
 
-      it "doesn't allow for multi-line picture tags" $ do
-        "<<ba\nz aar>>" `shouldParseTo` "<<ba\nz aar>>"
 
     context "when parsing anchors" $ do
       it "parses a single word anchor" $ do