From b8dcf173c272ebf85bbf2b427f84522e1474d092 Mon Sep 17 00:00:00 2001
From: Simon Hengel <sol@typeful.net>
Date: Wed, 11 Apr 2012 07:54:33 +0200
Subject: Add support for hyperlink labels to parser

---
 src/Haddock/Parse.y  | 11 ++++++++++-
 src/Haddock/Types.hs |  2 +-
 2 files changed, 11 insertions(+), 2 deletions(-)

(limited to 'src')

diff --git a/src/Haddock/Parse.y b/src/Haddock/Parse.y
index 0cc783ee..b34b14b9 100644
--- a/src/Haddock/Parse.y
+++ b/src/Haddock/Parse.y
@@ -107,7 +107,7 @@ seq1	:: { Doc RdrName }
 elem1	:: { Doc RdrName }
 	: STRING		{ DocString $1 }
 	| '/../'                { DocEmphasis (DocString $1) }
-	| URL			{ DocHyperlink (Hyperlink $1 Nothing) }
+	| URL			{ DocHyperlink (makeHyperlink $1) }
 	| PIC                   { DocPic $1 }
 	| ANAME			{ DocAName $1 }
 	| IDENT			{ DocIdentifier $1 }
@@ -121,6 +121,15 @@ strings  :: { String }
 happyError :: [LToken] -> Maybe a
 happyError toks = Nothing
 
+-- | Create a `Hyperlink` from given string.
+--
+-- A hyperlink consists of a URL and an optional label.  The label is separated
+-- from the url by one or more whitespace characters.
+makeHyperlink :: String -> Hyperlink
+makeHyperlink input = case break isSpace $ strip input of
+  (url, "")    -> Hyperlink url Nothing
+  (url, label) -> Hyperlink url (Just . dropWhile isSpace $ label)
+
 -- | Create an 'Example', stripping superfluous characters as appropriate
 makeExample :: String -> String -> [String] -> Example
 makeExample prompt expression result =
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index f8890ebf..0d486ae8 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -318,7 +318,7 @@ instance Monoid (Doc id) where
 data Hyperlink = Hyperlink
   { hyperlinkUrl   :: String
   , hyperlinkLabel :: Maybe String
-  }
+  } deriving (Eq, Show)
 
 
 data Example = Example
-- 
cgit v1.2.3