Add support for markdown images

1 files changed, 10 insertions, 2 deletions

diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index f1fd5dda..ff03c7bb 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 "]")