Add support for hyperlink labels to parser

3 files changed, 25 insertions, 2 deletions

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
diff --git a/tests/unit-tests/parsetests.hs b/tests/unit-tests/parsetests.hs
index 7180a79e..0192ebfc 100644
--- a/tests/unit-tests/parsetests.hs
+++ b/tests/unit-tests/parsetests.hs
@@ -9,6 +9,7 @@ import Haddock.Lex (tokenise)
 import Haddock.Parse (parseParas)
 import Haddock.Types
 import Outputable
+import Data.Monoid
 
 instance Outputable a => Show a where
   show = showSDoc . ppr
@@ -53,8 +54,21 @@ tests = [
       input  = ">>> putFooBar\nfoo\n<BLANKLINE>\nbar"
     , result = Just $ DocExamples $ [Example "putFooBar" ["foo","","bar"]]
     }
+
+  -- tests for links
+  , ParseTest {
+      input  = "<http://example.com/>"
+    , result = Just . DocParagraph $ hyperlink "http://example.com/" Nothing `mappend` DocString "\n"
+    }
+
+  , ParseTest {
+      input  = "<http://example.com/ some link>"
+    , result = Just . DocParagraph $ hyperlink "http://example.com/" (Just "some link") `mappend` DocString "\n"
+    }
   ]
 
+hyperlink :: String -> Maybe String -> Doc RdrName
+hyperlink url = DocHyperlink . Hyperlink url
 
 main :: IO ()
 main = do