From 769bfb301703d5d028d91189744f41ddef144854 Mon Sep 17 00:00:00 2001
From: David Waern <david.waern@gmail.com>
Date: Fri, 10 Oct 2008 22:35:49 +0000
Subject: Add support for DocPic

The support for DocPic was merged into the GHC source long ago,
but the support in Haddock was forgotten. Thanks Peter Gavin for
submitting this fix!
---
 src/Haddock/Backends/Hoogle.hs  | 1 +
 src/Haddock/Backends/Html.hs    | 1 +
 src/Haddock/Interface/Rename.hs | 1 +
 src/Haddock/Types.hs            | 3 ++-
 src/Haddock/Utils.hs            | 6 ++++--
 5 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 044c136d..684d4294 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -198,6 +198,7 @@ markupTag = Markup {
   markupModule        = box (TagInline "a") . str,
   markupEmphasis      = box (TagInline "i"),
   markupMonospaced    = box (TagInline "tt"),
+  markupPic           = const $ str " ",
   markupUnorderedList = box (TagL 'u'),
   markupOrderedList   = box (TagL 'o'),
   markupDefList       = box (TagL 'u') . map (\(a,b) -> TagInline "i" a : Str " " : b),
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs
index 8b72c1ac..ba304e5c 100644
--- a/src/Haddock/Backends/Html.hs
+++ b/src/Haddock/Backends/Html.hs
@@ -1496,6 +1496,7 @@ parHtmlMarkup ppId = Markup {
   markupEmphasis      = emphasize . toHtml,
   markupMonospaced    = tt . toHtml,
   markupUnorderedList = ulist . concatHtml . map (li <<),
+  markupPic           = \path -> image ! [src path],
   markupOrderedList   = olist . concatHtml . map (li <<),
   markupDefList       = dlist . concatHtml . map markupDef,
   markupCodeBlock     = pre,
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index d9488ac2..4f45da3a 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -188,6 +188,7 @@ renameDoc doc = case doc of
     doc' <- renameDoc doc
     return (DocCodeBlock doc')
   DocURL str -> return (DocURL str) 
+  DocPic str -> return (DocPic str)
   DocAName str -> return (DocAName str)
 
 
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 5a76a63e..fe963f42 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -188,7 +188,8 @@ data DocMarkup id a = Markup {
   markupDefList       :: [(a,a)] -> a,
   markupCodeBlock     :: a -> a,
   markupURL           :: String -> a,
-  markupAName         :: String -> a
+  markupAName         :: String -> a,
+  markupPic           :: String -> a
 }
 
 
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index 8fe64b30..4c2a7a8e 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -330,6 +330,7 @@ markup m (DocDefList ds)       = markupDefList m (map (markupPair m) ds)
 markup m (DocCodeBlock d)      = markupCodeBlock m (markup m d)
 markup m (DocURL url)          = markupURL m url
 markup m (DocAName ref)        = markupAName m ref
+markup m (DocPic img)          = markupPic m img
 
 markupPair :: DocMarkup id a -> (HsDoc id, HsDoc id) -> (a, a)
 markupPair m (a,b) = (markup m a, markup m b)
@@ -349,8 +350,9 @@ idMarkup = Markup {
   markupOrderedList   = DocOrderedList,
   markupDefList       = DocDefList,
   markupCodeBlock     = DocCodeBlock,
-  markupURL	      = DocURL,
-  markupAName	      = DocAName
+  markupURL           = DocURL,
+  markupAName         = DocAName,
+  markupPic           = DocPic
   }
 
 -- | Since marking up is just a matter of mapping 'Doc' into some
-- 
cgit v1.2.3