Merge branch 'dev' of https://github.com/sol/haddock into ghc-7.6

Conflicts:
	src/Haddock/InterfaceFile.hs

19 files changed, 197 insertions, 28 deletions

diff --git a/haddock.cabal b/haddock.cabal
index e133e51e..c9bad59a 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -104,8 +104,6 @@ executable haddock
 
   main-is:              Main.hs
   hs-source-dirs:       src
-  default-extensions:   CPP, DeriveDataTypeable,
-                        ScopedTypeVariables, MagicHash
   ghc-options:          -funbox-strict-fields -O2 -Wall -fwarn-tabs
 
   other-modules:
@@ -165,8 +163,6 @@ library
     build-depends: QuickCheck >= 2.1 && < 3
 
   hs-source-dirs:       src
-  default-extensions:   CPP, DeriveDataTypeable,
-                        ScopedTypeVariables, MagicHash
   ghc-options:          -funbox-strict-fields -O2 -Wall -fwarn-tabs
 
   exposed-modules:
diff --git a/src/.ghci b/src/.ghci
index f00e6d55..3e83f04c 100644
--- a/src/.ghci
+++ b/src/.ghci
@@ -1 +1 @@
-:set -i../dist/build/autogen -i../dist/build/haddock/haddock-tmp/ -packageghc -optP-include -optP../dist/build/autogen/cabal_macros.h -XCPP -XDeriveDataTypeable -XScopedTypeVariables -XMagicHash
+:set -i../dist/build/autogen -i../dist/build/haddock/haddock-tmp/ -packageghc -optP-include -optP../dist/build/autogen/cabal_macros.h
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 55f6ac1d..4949daa1 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -254,7 +254,7 @@ markupTag dflags = 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 c187f104..68cf715a 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -1001,7 +1001,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
   }
@@ -1010,6 +1010,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
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index a4d4764e..50451666 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE CPP, MagicHash #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Interface.AttachInstances
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 4bb46cba..64995a5f 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -688,6 +688,7 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap) decls =
         f (L l (SigD (GenericSig names t))) xs = foldr (\n acc -> L l (SigD (GenericSig [n] t)) : acc) xs names
         f x xs = x : xs
 
+    mkExportItem :: LHsDecl Name -> ErrMsgGhc (Maybe (ExportItem Name))
     mkExportItem (L _ (DocD (DocGroup lev docStr))) = do
       mbDoc <- liftErrMsg $ processDocString dflags gre docStr
       return $ fmap (ExportGroup lev "") mbDoc
@@ -762,7 +763,7 @@ extractRecSel nm mdl t tvs (L _ con : rest) =
   data_ty = foldl (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar t)) (map toTypeNoLoc tvs)
 
 
--- | Keep exprt items with docs.
+-- | Keep export items with docs.
 pruneExportItems :: [ExportItem Name] -> [ExportItem Name]
 pruneExportItems = filter hasDoc
   where
diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs
index d68f78f8..a5eb1143 100644
--- a/src/Haddock/Interface/LexParseRn.hs
+++ b/src/Haddock/Interface/LexParseRn.hs
@@ -115,7 +115,7 @@ rename dflags gre = rn
       DocCodeBlock doc -> DocCodeBlock (rn doc)
       DocIdentifierUnchecked x -> DocIdentifierUnchecked x
       DocModule str -> DocModule str
-      DocURL str -> DocURL str
+      DocHyperlink l -> DocHyperlink l
       DocPic str -> DocPic str
       DocAName str -> DocAName str
       DocExamples e -> DocExamples e
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 6109c341..0f702683 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -199,7 +199,7 @@ renameDoc d = case d of
   DocCodeBlock doc -> do
     doc' <- renameDoc doc
     return (DocCodeBlock doc')
-  DocURL str -> return (DocURL str)
+  DocHyperlink l -> return (DocHyperlink l)
   DocPic str -> return (DocPic str)
   DocAName str -> return (DocAName str)
   DocExamples e -> return (DocExamples e)
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index c2f1eb5c..8fa8ce95 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
@@ -66,15 +66,15 @@ binaryInterfaceMagic = 0xD0Cface
 -- we version our interface files accordingly.
 binaryInterfaceVersion :: Word16
 #if __GLASGOW_HASKELL__ == 702
-binaryInterfaceVersion = 20
+binaryInterfaceVersion = 21
 #elif __GLASGOW_HASKELL__ == 703
-binaryInterfaceVersion = 20
+binaryInterfaceVersion = 21
 #elif __GLASGOW_HASKELL__ == 704
-binaryInterfaceVersion = 20
+binaryInterfaceVersion = 21
 #elif __GLASGOW_HASKELL__ == 705
-binaryInterfaceVersion = 20
+binaryInterfaceVersion = 21
 #elif __GLASGOW_HASKELL__ == 706
-binaryInterfaceVersion = 20
+binaryInterfaceVersion = 21
 #else
 #error Unknown GHC version
 #endif
@@ -415,6 +415,15 @@ instance Binary Example where
         result <- get bh
         return (Example expression result)
 
+instance Binary Hyperlink where
+    put_ bh (Hyperlink url label) = do
+        put_ bh url
+        put_ bh label
+    get bh = do
+        url <- get bh
+        label <- get bh
+        return (Hyperlink url label)
+
 
 {-* Generated by DrIFT : Look, but Don't Touch. *-}
 instance (Binary id) => Binary (Doc id) where
@@ -454,7 +463,7 @@ instance (Binary id) => Binary (Doc id) where
     put_ bh (DocCodeBlock al) = do
             putByte bh 11
             put_ bh al
-    put_ bh (DocURL am) = do
+    put_ bh (DocHyperlink am) = do
             putByte bh 12
             put_ bh am
     put_ bh (DocPic x) = do
@@ -513,7 +522,7 @@ instance (Binary id) => Binary (Doc id) where
                     return (DocCodeBlock al)
               12 -> do
                     am <- get bh
-                    return (DocURL am)
+                    return (DocHyperlink am)
               13 -> do
                     x <- get bh
                     return (DocPic x)
diff --git a/src/Haddock/Parse.y b/src/Haddock/Parse.y
index e36e8416..b34b14b9 100644
--- a/src/Haddock/Parse.y
+++ b/src/Haddock/Parse.y
@@ -10,7 +10,7 @@
 module Haddock.Parse where
 
 import Haddock.Lex
-import Haddock.Types (Doc(..), Example(Example))
+import Haddock.Types (Doc(..), Example(Example), Hyperlink(..))
 import Haddock.Doc
 import HsSyn
 import RdrName
@@ -107,7 +107,7 @@ seq1	:: { Doc RdrName }
 elem1	:: { Doc RdrName }
 	: STRING		{ DocString $1 }
 	| '/../'                { DocEmphasis (DocString $1) }
-	| URL			{ DocURL $1 }
+	| 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 3cadf33a..e1e7ce4b 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -303,7 +303,7 @@ data Doc id
   | DocOrderedList [Doc id]
   | DocDefList [(Doc id, Doc id)]
   | DocCodeBlock (Doc id)
-  | DocURL String
+  | DocHyperlink Hyperlink
   | DocPic String
   | DocAName String
   | DocExamples [Example]
@@ -315,6 +315,12 @@ instance Monoid (Doc id) where
   mappend = DocAppend
 
 
+data Hyperlink = Hyperlink
+  { hyperlinkUrl   :: String
+  , hyperlinkLabel :: Maybe String
+  } deriving (Eq, Show)
+
+
 data Example = Example
   { exampleExpression :: String
   , exampleResult     :: [String]
@@ -341,7 +347,7 @@ data DocMarkup id a = Markup
   , markupOrderedList          :: [a] -> a
   , markupDefList              :: [(a,a)] -> a
   , markupCodeBlock            :: a -> a
-  , markupURL                  :: String -> a
+  , markupHyperlink            :: Hyperlink -> a
   , markupAName                :: String -> a
   , markupPic                  :: String -> a
   , markupExample              :: [Example] -> a
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index 53e8bba8..b8f32589 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Utils
@@ -428,7 +429,7 @@ markup m (DocUnorderedList ds)       = markupUnorderedList m (map (markup m) ds)
 markup m (DocOrderedList ds)         = markupOrderedList m (map (markup m) ds)
 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 (DocHyperlink l)            = markupHyperlink m l
 markup m (DocAName ref)              = markupAName m ref
 markup m (DocPic img)                = markupPic m img
 markup m (DocExamples e)             = markupExample m e
@@ -455,7 +456,7 @@ idMarkup = Markup {
   markupOrderedList          = DocOrderedList,
   markupDefList              = DocDefList,
   markupCodeBlock            = DocCodeBlock,
-  markupURL                  = DocURL,
+  markupHyperlink            = DocHyperlink,
   markupAName                = DocAName,
   markupPic                  = DocPic,
   markupExample              = DocExamples
diff --git a/src/Main.hs b/src/Main.hs
index beb01b86..31e2726c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,5 +1,5 @@
 {-# OPTIONS_GHC -Wwarn #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Main
diff --git a/tests/html-tests/tests/Hyperlinks.hs b/tests/html-tests/tests/Hyperlinks.hs
new file mode 100644
index 00000000..34e64448
--- /dev/null
+++ b/tests/html-tests/tests/Hyperlinks.hs
@@ -0,0 +1,8 @@
+module Hyperlinks where
+
+-- |
+-- A plain URL: <http://example.com/>
+--
+-- A URL with a label: <http://example.com/ some link>
+foo :: Int
+foo = 23
diff --git a/tests/html-tests/tests/Hyperlinks.html.ref b/tests/html-tests/tests/Hyperlinks.html.ref
new file mode 100644
index 00000000..59ec6c26
--- /dev/null
+++ b/tests/html-tests/tests/Hyperlinks.html.ref
@@ -0,0 +1,89 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+  ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+     /><title
+    >Hyperlinks</title
+    ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean"
+     /><script src="haddock-util.js" type="text/javascript"
+    ></script
+    ><script type="text/javascript"
+    >//<![CDATA[
+window.onload = function () {pageLoad();setSynopsis("mini_Hyperlinks.html");};
+//]]>
+</script
+    ></head
+  ><body
+  ><div id="package-header"
+    ><ul class="links" id="page-menu"
+      ><li
+	><a href=""
+	  >Contents</a
+	  ></li
+	><li
+	><a href=""
+	  >Index</a
+	  ></li
+	></ul
+      ><p class="caption empty"
+      >&nbsp;</p
+      ></div
+    ><div id="content"
+    ><div id="module-header"
+      ><table class="info"
+	><tr
+	  ><th
+	    >Safe Haskell</th
+	    ><td
+	    >None</td
+	    ></tr
+	  ></table
+	><p class="caption"
+	>Hyperlinks</p
+	></div
+      ><div id="synopsis"
+      ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')"
+	>Synopsis</p
+	><ul id="section.syn" class="hide" onclick="toggleSection('syn')"
+	><li class="src short"
+	  ><a href=""
+	    >foo</a
+	    > :: <a href=""
+	    >Int</a
+	    ></li
+	  ></ul
+	></div
+      ><div id="interface"
+      ><h1
+	>Documentation</h1
+	><div class="top"
+	><p class="src"
+	  ><a name="v:foo" class="def"
+	    >foo</a
+	    > :: <a href=""
+	    >Int</a
+	    ></p
+	  ><div class="doc"
+	  ><p
+	    >A plain URL: <a href=""
+	      >http://example.com/</a
+	      >
+</p
+	    ><p
+	    >A URL with a label: <a href=""
+	      >some link</a
+	      >
+</p
+	    ></div
+	  ></div
+	></div
+      ></div
+    ><div id="footer"
+    ><p
+      >Produced by <a href=""
+	>Haddock</a
+	> version 2.10.0</p
+      ></div
+    ></body
+  ></html
+>
diff --git a/tests/html-tests/tests/mini_Hyperlinks.html.ref b/tests/html-tests/tests/mini_Hyperlinks.html.ref
new file mode 100644
index 00000000..f0c7d65a
--- /dev/null
+++ b/tests/html-tests/tests/mini_Hyperlinks.html.ref
@@ -0,0 +1,31 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+  ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+     /><title
+    >Hyperlinks</title
+    ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean"
+     /><script src="haddock-util.js" type="text/javascript"
+    ></script
+    ><script type="text/javascript"
+    >//<![CDATA[
+window.onload = function () {pageLoad();};
+//]]>
+</script
+    ></head
+  ><body id="mini"
+  ><div id="module-header"
+    ><p class="caption"
+      >Hyperlinks</p
+      ></div
+    ><div id="interface"
+    ><div class="top"
+      ><p class="src"
+	><a href="" target="main"
+	  >foo</a
+	  ></p
+	></div
+      ></div
+    ></body
+  ></html
+>
diff --git a/tests/unit-tests/.ghci b/tests/unit-tests/.ghci
index 10563664..dcc5b13d 100644
--- a/tests/unit-tests/.ghci
+++ b/tests/unit-tests/.ghci
@@ -1 +1 @@
-:set -i../../src -i../../dist/build/autogen -i../../dist/build/haddock/haddock-tmp/ -packageghc -optP-include -optP../../dist/build/autogen/cabal_macros.h -XCPP -XDeriveDataTypeable -XScopedTypeVariables -XMagicHash
+:set -i../../src -i../../dist/build/autogen -i../../dist/build/haddock/haddock-tmp/ -packageghc -optP-include -optP../../dist/build/autogen/cabal_macros.h
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