From b19a4bea999c684e092e0ea0feaf02ff8747d2a5 Mon Sep 17 00:00:00 2001
From: Simon Hengel <sol@typeful.net>
Date: Wed, 4 Apr 2012 16:32:11 +0200
Subject: Add an optional label to URLs

---
 src/Haddock/Backends/Hoogle.hs          | 2 +-
 src/Haddock/Backends/LaTeX.hs           | 6 +++++-
 src/Haddock/Backends/Xhtml/DocMarkup.hs | 3 ++-
 3 files changed, 8 insertions(+), 3 deletions(-)

(limited to 'src/Haddock/Backends')

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index d27ca80f..25ca65e9 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -247,7 +247,7 @@ markupTag = Markup {
   markupOrderedList          = box (TagL 'o'),
   markupDefList              = box (TagL 'u') . map (\(a,b) -> TagInline "i" a : Str " " : b),
   markupCodeBlock            = box TagPre,
-  markupURL                  = box (TagInline "a") . str,
+  markupHyperlink            = \(Hyperlink url mLabel) -> (box (TagInline "a") . str) (fromMaybe url mLabel),
   markupAName                = const $ str "",
   markupExample              = box TagPre . str . unlines . map exampleToString
   }
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 31ba3b0b..ef72505c 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -1011,7 +1011,7 @@ parLatexMarkup ppId = Markup {
   markupOrderedList          = \p v -> enumeratedList (map ($v) p) $$ text "",
   markupDefList              = \l v -> descriptionList (map (\(a,b) -> (a v, b v)) l),
   markupCodeBlock            = \p _ -> quote (verb (p Verb)) $$ text "",
-  markupURL                  = \u _ -> text "\\url" <> braces (text u),
+  markupHyperlink            = \l _ -> markupLink l,
   markupAName                = \_ _ -> empty,
   markupExample              = \e _ -> quote $ verb $ text $ unlines $ map exampleToString e
   }
@@ -1020,6 +1020,10 @@ parLatexMarkup ppId = Markup {
     fixString Verb  s = s
     fixString Mono  s = latexMonoFilter s
 
+    markupLink (Hyperlink url mLabel) = case mLabel of
+      Just label -> text "\\href" <> braces (text url) <> braces (text label)
+      Nothing    -> text "\\url"  <> braces (text url)
+
     markupId ppId_ id v =
       case v of
         Verb  -> theid
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 052116ee..e75cfaba 100644
--- a/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -25,6 +25,7 @@ import Haddock.Types
 import Haddock.Utils
 
 import Text.XHtml hiding ( name, title, p, quote )
+import Data.Maybe (fromMaybe)
 
 import GHC
 
@@ -46,7 +47,7 @@ parHtmlMarkup qual ppId = Markup {
   markupOrderedList          = ordList,
   markupDefList              = defList,
   markupCodeBlock            = pre,
-  markupURL                  = \url -> anchor ! [href url] << url,
+  markupHyperlink            = \(Hyperlink url mLabel) -> anchor ! [href url] << fromMaybe url mLabel,
   markupAName                = \aname -> namedAnchor aname << "",
   markupPic                  = \path -> image ! [src path],
   markupExample              = examplesToHtml
-- 
cgit v1.2.3