aboutsummaryrefslogtreecommitdiff
path: root/haddock-library/src
diff options
context:
space:
mode:
authorSimon Hengel <sol@typeful.net>2014-11-02 13:54:19 +0800
committerSimon Hengel <sol@typeful.net>2014-11-03 09:34:20 +0800
commitaf85d14f001cf4c2976ee659ec04101d6b054a4d (patch)
treea1008160996b873ff5e78512ad9e679aee3b9a39 /haddock-library/src
parentd1f0e6ed1e271eb165abdecf7a5eae4f5c573ade (diff)
Add support for markdown images
Diffstat (limited to 'haddock-library/src')
-rw-r--r--haddock-library/src/Documentation/Haddock/Parser.hs12
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 "]")