From ce0237fa8f482a64dc8ea3ec409a1482ac89e6ac Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 4 Jun 2015 19:27:34 +0200
Subject: [PATCH 001/109] Create scaffolding for Haskell source parser module.

---
 haddock-api/haddock-api.cabal                 |  1 +
 .../Haddock/Backends/Hyperlinker/Parser.hs    | 36 +++++++++++++++++++
 2 files changed, 37 insertions(+)
 create mode 100644 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 3bc222631d..b90e3bff46 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -79,6 +79,7 @@ library
     Haddock.Backends.LaTeX
     Haddock.Backends.HaddockDB
     Haddock.Backends.Hoogle
+    Haddock.Backends.Hyperlinker.Parser
     Haddock.ModuleTree
     Haddock.Types
     Haddock.Doc
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
new file mode 100644
index 0000000000..11a92b5731
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -0,0 +1,36 @@
+module Haddock.Backends.Hyperlinker.Parser (parse) where
+
+data Token = Token
+    { tkType :: TokenType
+    , tkValue :: String
+    , tkSpan :: Span
+    }
+
+data Position = Position
+    { posRow :: !Int
+    , posCol :: !Int
+    }
+
+data Span = Span
+    { spStart :: Position
+    , spEnd :: Position
+    }
+
+data TokenType
+    = Identifier
+    | Comment
+    | Whitespace
+    | Operator
+    | Symbol
+
+parse :: String -> [Token]
+parse = tokenize . tag . chunk
+
+chunk :: String -> [String]
+chunk = undefined
+
+tag :: [String] -> [(Span, String)]
+tag = undefined
+
+tokenize :: [(Span, String)] -> [Token]
+tokenize = undefined

From e17f62506ecf20d61781c610d6fbb5f3c8cd132e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 4 Jun 2015 19:59:27 +0200
Subject: [PATCH 002/109] Implement function for tagging parsed chunks with
 source spans.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 11a92b5731..4bcc0c8ac8 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -30,7 +30,14 @@ chunk :: String -> [String]
 chunk = undefined
 
 tag :: [String] -> [(Span, String)]
-tag = undefined
+tag =
+    reverse . snd . foldl aux (Position 1 1, [])
+  where
+    aux (pos, cs) c =
+        let pos' = if c == "\n"
+                   then pos { posRow = posRow pos + 1, posCol = 1 }
+                   else pos { posCol = posCol pos + length c }
+        in (pos', (Span pos pos', c):cs)
 
 tokenize :: [(Span, String)] -> [Token]
 tokenize = undefined

From 413f7f322cd174e2ba4116dbf53c1b3c0d6a4f77 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 4 Jun 2015 21:10:26 +0200
Subject: [PATCH 003/109] Implement simple string chunking based on HsColour
 library.

---
 .../Haddock/Backends/Hyperlinker/Parser.hs    | 28 ++++++++++++++++++-
 1 file changed, 27 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 4bcc0c8ac8..4e0d73828a 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -1,5 +1,8 @@
 module Haddock.Backends.Hyperlinker.Parser (parse) where
 
+import Data.Char
+import Data.List
+
 data Token = Token
     { tkType :: TokenType
     , tkValue :: String
@@ -27,7 +30,30 @@ parse :: String -> [Token]
 parse = tokenize . tag . chunk
 
 chunk :: String -> [String]
-chunk = undefined
+chunk [] = []
+chunk str@(c:_)
+    | isSpace c = chunk' $ span isSpace str
+chunk str
+    | "--" `isPrefixOf` str = chunk' $ span (not . (== '\n')) str
+    | "{-" `isPrefixOf` str = chunk' $ chunkComment 0 str
+    | otherwise = chunk' $ head $ lex str
+
+chunk' :: (String, String) -> [String]
+chunk' (c, rest) = c:(chunk rest)
+
+chunkComment :: Int -> String -> (String, String)
+chunkComment _ [] = ("", "")
+chunkComment depth ('{':'-':str) =
+    let (c, rest) = chunkComment (depth + 1) str
+    in ("{-" ++ c, rest)
+chunkComment depth ('-':'}':str)
+    | depth == 1 = ("-}", str)
+    | otherwise =
+        let (c, rest) = chunkComment (depth - 1) str
+        in ("-}" ++ c, rest)
+chunkComment depth (e:str) =
+    let (c, rest) = chunkComment depth str
+    in (e:c, rest)
 
 tag :: [String] -> [(Span, String)]
 tag =

From 6fb8d5abbcc92f5155fdc9596ca1c87fe87f6187 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 4 Jun 2015 23:21:17 +0200
Subject: [PATCH 004/109] Create basic token classification method.

---
 .../Haddock/Backends/Hyperlinker/Parser.hs    | 104 +++++++++++++++++-
 1 file changed, 98 insertions(+), 6 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 4e0d73828a..be6b7ce5fa 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -20,11 +20,18 @@ data Span = Span
     }
 
 data TokenType
-    = Identifier
-    | Comment
-    | Whitespace
-    | Operator
-    | Symbol
+    = TkIdentifier
+    | TkKeyword
+    | TkString
+    | TkChar
+    | TkNumber
+    | TkOperator
+    | TkGlyph
+    | TkSpecial
+    | TkSpace
+    | TkComment
+    | TkCpp
+    | TkUnknown
 
 parse :: String -> [Token]
 parse = tokenize . tag . chunk
@@ -66,4 +73,89 @@ tag =
         in (pos', (Span pos pos', c):cs)
 
 tokenize :: [(Span, String)] -> [Token]
-tokenize = undefined
+tokenize =
+    map aux
+  where
+    aux (sp, str) = Token
+        { tkType = classify str
+        , tkValue = str
+        , tkSpan = sp
+        }
+
+classify :: String -> TokenType
+classify (c:_)
+    | isSpace c = TkSpace
+    | isDigit c = TkNumber
+    | c `elem` special = TkSpecial
+    | c == '#' = TkCpp
+    | c == '"' = TkString
+    | c == '\'' = TkChar
+classify str
+    | str `elem` keywords = TkKeyword
+    | str `elem` glyphs = TkGlyph
+    | all (`elem` symbols) str = TkOperator
+    | "--" `isPrefixOf` str = TkComment
+    | "{-" `isPrefixOf` str = TkComment
+    | isIdentifier str = TkIdentifier
+    | otherwise = TkUnknown
+
+keywords :: [String]
+keywords =
+    [ "as"
+    , "case"
+    , "class"
+    , "data"
+    , "default"
+    , "deriving"
+    , "do"
+    , "else"
+    , "hiding"
+    , "if"
+    , "import"
+    , "in"
+    , "infix"
+    , "infixl"
+    , "infixr"
+    , "instance"
+    , "let"
+    , "module"
+    , "newtype"
+    , "of"
+    , "qualified"
+    , "then"
+    , "type"
+    , "where"
+    , "forall"
+    , "mdo"
+    ]
+
+glyphs :: [String]
+glyphs =
+    [ ".."
+    , ":"
+    , "::"
+    , "="
+    , "\\"
+    , "|"
+    , "<-"
+    , "->"
+    , "@"
+    , "~"
+    , "~#"
+    , "=>"
+    , "-"
+    , "!"
+    ]
+
+special :: [Char]
+special = "()[]{},;`"
+
+-- TODO: Add support for any Unicode symbol or punctuation.
+-- source: http://stackoverflow.com/questions/10548170/what-characters-are-permitted-for-haskell-operators
+symbols :: [Char]
+symbols = "!#$%&*+./<=>?@\\^|-~:"
+
+isIdentifier :: String -> Bool
+isIdentifier (c:str)
+    | isLetter c = all (\c' -> isAlphaNum c' || c == '\'') str
+isIdentifier _ = False

From 57d4c9cff1d60f7dd0f8dafae5537218b63da90f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 5 Jun 2015 00:07:52 +0200
Subject: [PATCH 005/109] Adapt source span tagging to work with current
 whitespace handling.

---
 .../src/Haddock/Backends/Hyperlinker/Parser.hs        | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index be6b7ce5fa..53ff1f6538 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -67,10 +67,13 @@ tag =
     reverse . snd . foldl aux (Position 1 1, [])
   where
     aux (pos, cs) c =
-        let pos' = if c == "\n"
-                   then pos { posRow = posRow pos + 1, posCol = 1 }
-                   else pos { posCol = posCol pos + length c }
-        in (pos', (Span pos pos', c):cs)
+        let pos' = move pos c
+        in (pos', ((Span pos pos', c):cs))
+    move pos str@(c:_)
+        | isSpace c = foldl move' pos str
+    move pos str = pos { posCol = posCol pos + length str }
+    move' pos '\n' = pos { posRow = posRow pos + 1, posCol = 1 }
+    move' pos _ = pos { posCol = posCol pos + 1 }
 
 tokenize :: [(Span, String)] -> [Token]
 tokenize =

From c7ecc590090d7f1a4ce8e6d0233c41350202a4bd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 5 Jun 2015 00:16:15 +0200
Subject: [PATCH 006/109] Add record accessors to exports of hyperlinker parser
 module.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 53ff1f6538..4130ab6cdd 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -1,4 +1,9 @@
-module Haddock.Backends.Hyperlinker.Parser (parse) where
+module Haddock.Backends.Hyperlinker.Parser
+    ( parse
+    , tkType, tkValue, tkSpan
+    , posRow, posCol
+    , spStart, spEnd
+    ) where
 
 import Data.Char
 import Data.List

From 7b607883d0cea7a795275a2484a33bd89a3b4fc6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 5 Jun 2015 11:56:01 +0200
Subject: [PATCH 007/109] Make parser module export all types and associated
 accessors.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 4130ab6cdd..7a162f6df6 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -1,8 +1,7 @@
 module Haddock.Backends.Hyperlinker.Parser
     ( parse
-    , tkType, tkValue, tkSpan
-    , posRow, posCol
-    , spStart, spEnd
+    , Token(..), TokenType(..)
+    , Position(..), Span(..)
     ) where
 
 import Data.Char

From 5e904cb1c3d769d5b99d459838b4b5368c8c1fb7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 5 Jun 2015 12:59:10 +0200
Subject: [PATCH 008/109] Create simple HTML renderer for parsed source file.

---
 haddock-api/haddock-api.cabal                 |  3 ++-
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 26 +++++++++++++++++++
 2 files changed, 28 insertions(+), 1 deletion(-)
 create mode 100644 haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index b90e3bff46..6c6dc8100f 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -57,6 +57,8 @@ library
 
   exposed-modules:
     Documentation.Haddock
+    Haddock.Backends.Hyperlinker.Parser
+    Haddock.Backends.Hyperlinker.Renderer
 
   other-modules:
     Haddock
@@ -79,7 +81,6 @@ library
     Haddock.Backends.LaTeX
     Haddock.Backends.HaddockDB
     Haddock.Backends.Hoogle
-    Haddock.Backends.Hyperlinker.Parser
     Haddock.ModuleTree
     Haddock.Types
     Haddock.Doc
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
new file mode 100644
index 0000000000..eaf5b37b24
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -0,0 +1,26 @@
+module Haddock.Backends.Hyperlinker.Renderer where
+
+import Haddock.Backends.Hyperlinker.Parser
+
+import Data.Monoid
+import Text.XHtml
+
+render :: [Token] -> Html
+render = body . pre . foldr (<>) noHtml . map renderToken
+
+renderToken :: Token -> Html
+renderToken (Token t v _) = thespan (toHtml v) ! tokenAttrs t
+
+tokenAttrs :: TokenType -> [HtmlAttr]
+tokenAttrs TkIdentifier = [theclass "hs-identifier"]
+tokenAttrs TkKeyword = [theclass "hs-keyword"]
+tokenAttrs TkString = [theclass "hs-string"]
+tokenAttrs TkChar = [theclass "hs-char"]
+tokenAttrs TkNumber = [theclass "hs-number"]
+tokenAttrs TkOperator = [theclass "hs-operator"]
+tokenAttrs TkGlyph = [theclass "hs-glyph"]
+tokenAttrs TkSpecial = [theclass "hs-special"]
+tokenAttrs TkSpace = []
+tokenAttrs TkComment = [theclass "hs-comment"]
+tokenAttrs TkCpp = [theclass "hs-cpp"]
+tokenAttrs TkUnknown = []

From 1a43f35e2dacc9837f9762fd211d63ae6cc7b4a3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 5 Jun 2015 13:58:47 +0200
Subject: [PATCH 009/109] Add support for specifying the CSS file path in HTML
 source renderer.

---
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 45 ++++++++++++-------
 1 file changed, 30 insertions(+), 15 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index eaf5b37b24..9ebb870767 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -3,24 +3,39 @@ module Haddock.Backends.Hyperlinker.Renderer where
 import Haddock.Backends.Hyperlinker.Parser
 
 import Data.Monoid
-import Text.XHtml
+import Text.XHtml (Html, HtmlAttr, (!))
+import qualified Text.XHtml as Html
 
-render :: [Token] -> Html
-render = body . pre . foldr (<>) noHtml . map renderToken
+render :: Maybe FilePath -> [Token] -> Html
+render css tokens = header css <> body tokens
 
-renderToken :: Token -> Html
-renderToken (Token t v _) = thespan (toHtml v) ! tokenAttrs t
+body :: [Token] -> Html
+body = Html.body . Html.pre . mconcat . map token
+
+header :: Maybe FilePath -> Html
+header Nothing = Html.noHtml
+header (Just css) =
+    Html.header $ Html.thelink Html.noHtml ! attrs
+  where
+    attrs =
+        [ Html.rel "stylesheet"
+        , Html.href css
+        , Html.thetype "text/css"
+        ]
+
+token :: Token -> Html
+token (Token t v _) = Html.thespan (Html.toHtml v) ! tokenAttrs t
 
 tokenAttrs :: TokenType -> [HtmlAttr]
-tokenAttrs TkIdentifier = [theclass "hs-identifier"]
-tokenAttrs TkKeyword = [theclass "hs-keyword"]
-tokenAttrs TkString = [theclass "hs-string"]
-tokenAttrs TkChar = [theclass "hs-char"]
-tokenAttrs TkNumber = [theclass "hs-number"]
-tokenAttrs TkOperator = [theclass "hs-operator"]
-tokenAttrs TkGlyph = [theclass "hs-glyph"]
-tokenAttrs TkSpecial = [theclass "hs-special"]
+tokenAttrs TkIdentifier = [Html.theclass "hs-identifier"]
+tokenAttrs TkKeyword = [Html.theclass "hs-keyword"]
+tokenAttrs TkString = [Html.theclass "hs-string"]
+tokenAttrs TkChar = [Html.theclass "hs-char"]
+tokenAttrs TkNumber = [Html.theclass "hs-number"]
+tokenAttrs TkOperator = [Html.theclass "hs-operator"]
+tokenAttrs TkGlyph = [Html.theclass "hs-glyph"]
+tokenAttrs TkSpecial = [Html.theclass "hs-special"]
 tokenAttrs TkSpace = []
-tokenAttrs TkComment = [theclass "hs-comment"]
-tokenAttrs TkCpp = [theclass "hs-cpp"]
+tokenAttrs TkComment = [Html.theclass "hs-comment"]
+tokenAttrs TkCpp = [Html.theclass "hs-cpp"]
 tokenAttrs TkUnknown = []

From 01a2e7c5ab873c0041624a6ec0b0a54eb7da60cc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 5 Jun 2015 14:39:28 +0200
Subject: [PATCH 010/109] Fix identifier recognition in Haskell source parser.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 7a162f6df6..9d58728fa0 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -163,6 +163,9 @@ symbols :: [Char]
 symbols = "!#$%&*+./<=>?@\\^|-~:"
 
 isIdentifier :: String -> Bool
-isIdentifier (c:str)
-    | isLetter c = all (\c' -> isAlphaNum c' || c == '\'') str
+isIdentifier (s:str)
+    | (isLower' s || isUpper s) && all isAlphaNum' str = True
+  where
+    isLower' c = isLower c || c == '_'
+    isAlphaNum' c = isAlphaNum c || c == '_' || c == '\''
 isIdentifier _ = False

From ffd0e8028f15f3616f1b3eaaf98459c0c75c6313 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 5 Jun 2015 14:56:59 +0200
Subject: [PATCH 011/109] Fix comment recognition in Haskell source parser.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 9d58728fa0..29edb4c323 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -90,6 +90,9 @@ tokenize =
         }
 
 classify :: String -> TokenType
+classify str
+    | "--" `isPrefixOf` str = TkComment
+    | "{-" `isPrefixOf` str = TkComment
 classify (c:_)
     | isSpace c = TkSpace
     | isDigit c = TkNumber
@@ -101,8 +104,6 @@ classify str
     | str `elem` keywords = TkKeyword
     | str `elem` glyphs = TkGlyph
     | all (`elem` symbols) str = TkOperator
-    | "--" `isPrefixOf` str = TkComment
-    | "{-" `isPrefixOf` str = TkComment
     | isIdentifier str = TkIdentifier
     | otherwise = TkUnknown
 

From e5bd5d39550692f936c973637f8ec8d314919359 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 5 Jun 2015 15:12:40 +0200
Subject: [PATCH 012/109] Add support for recognizing compiler pragmas in
 source parser.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs   | 2 ++
 haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs | 1 +
 2 files changed, 3 insertions(+)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 29edb4c323..0e1ad5b250 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -35,6 +35,7 @@ data TokenType
     | TkSpace
     | TkComment
     | TkCpp
+    | TkPragma
     | TkUnknown
 
 parse :: String -> [Token]
@@ -92,6 +93,7 @@ tokenize =
 classify :: String -> TokenType
 classify str
     | "--" `isPrefixOf` str = TkComment
+    | "{-#" `isPrefixOf` str = TkPragma
     | "{-" `isPrefixOf` str = TkComment
 classify (c:_)
     | isSpace c = TkSpace
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 9ebb870767..39d7d183d6 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -38,4 +38,5 @@ tokenAttrs TkSpecial = [Html.theclass "hs-special"]
 tokenAttrs TkSpace = []
 tokenAttrs TkComment = [Html.theclass "hs-comment"]
 tokenAttrs TkCpp = [Html.theclass "hs-cpp"]
+tokenAttrs TkPragma = [Html.theclass "hs-pragma"]
 tokenAttrs TkUnknown = []

From d275f87c4cfa1e8da042f70659331121afa9a15c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sat, 6 Jun 2015 19:27:37 +0200
Subject: [PATCH 013/109] Create scaffolding of module for associating tokens
 with AST names.

---
 haddock-api/haddock-api.cabal                 |  1 +
 .../src/Haddock/Backends/Hyperlinker/Ast.hs   | 20 +++++++++++++++++++
 2 files changed, 21 insertions(+)
 create mode 100644 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 6c6dc8100f..109e5f9555 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -59,6 +59,7 @@ library
     Documentation.Haddock
     Haddock.Backends.Hyperlinker.Parser
     Haddock.Backends.Hyperlinker.Renderer
+    Haddock.Backends.Hyperlinker.Ast
 
   other-modules:
     Haddock
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
new file mode 100644
index 0000000000..abd3ca2b57
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -0,0 +1,20 @@
+module Haddock.Backends.Hyperlinker.Ast where
+
+import qualified GHC
+
+import Haddock.Backends.Hyperlinker.Parser
+
+data RichToken = RichToken
+    { rtkToken :: Token
+    , rtkName :: Maybe GHC.Name
+    }
+
+enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
+enrich src =
+    map $ \token -> RichToken
+        { rtkToken = token
+        , rtkName = lookupName src $ tkSpan token
+        }
+
+lookupName :: GHC.RenamedSource -> Span -> Maybe GHC.Name
+lookupName = undefined

From 74de0021815f0642a89017fbb1fbdf18064cb5ea Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sat, 6 Jun 2015 19:36:53 +0200
Subject: [PATCH 014/109] Implement utility method for extracting variable
 identifiers from AST.

---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs      | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index abd3ca2b57..62c0d4395b 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -1,6 +1,10 @@
+{-# LANGUAGE RankNTypes #-}
+
 module Haddock.Backends.Hyperlinker.Ast where
 
 import qualified GHC
+import Data.Data
+import Control.Applicative
 
 import Haddock.Backends.Hyperlinker.Parser
 
@@ -18,3 +22,15 @@ enrich src =
 
 lookupName :: GHC.RenamedSource -> Span -> Maybe GHC.Name
 lookupName = undefined
+
+everything :: (r -> r -> r) -> (forall a. Data a => a -> r)
+           -> (forall a. Data a => a -> r)
+everything k f x = foldl k (f x) (gmapQ (everything k f) x)
+
+variables :: GHC.RenamedSource -> [(GHC.SrcSpan, GHC.Name)]
+variables =
+    everything (<|>) var
+  where
+    var term = case cast term of
+        (Just (GHC.L sspan (GHC.HsVar sid))) -> pure (sspan, sid)
+        _ -> empty

From d06a2b502e7909dff517a7c825e772b493bade24 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sat, 6 Jun 2015 20:04:02 +0200
Subject: [PATCH 015/109] Create simple mechanism for associating tokens with
 AST names.

---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs   | 30 ++++++++++++++-----
 1 file changed, 23 insertions(+), 7 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 62c0d4395b..031ddd5c58 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -2,11 +2,13 @@
 
 module Haddock.Backends.Hyperlinker.Ast where
 
+import Haddock.Backends.Hyperlinker.Parser
+
 import qualified GHC
-import Data.Data
-import Control.Applicative
 
-import Haddock.Backends.Hyperlinker.Parser
+import Control.Applicative
+import Data.Data
+import Data.Maybe
 
 data RichToken = RichToken
     { rtkToken :: Token
@@ -17,20 +19,34 @@ enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
 enrich src =
     map $ \token -> RichToken
         { rtkToken = token
-        , rtkName = lookupName src $ tkSpan token
+        , rtkName = lookupBySpan (tkSpan token) nameMap
         }
+  where
+    nameMap = variables src
+
+type NameMap = [(GHC.SrcSpan, GHC.Name)]
 
-lookupName :: GHC.RenamedSource -> Span -> Maybe GHC.Name
-lookupName = undefined
+lookupBySpan :: Span -> NameMap -> Maybe GHC.Name
+lookupBySpan tspan = listToMaybe . map snd . filter (matches tspan . fst)
 
 everything :: (r -> r -> r) -> (forall a. Data a => a -> r)
            -> (forall a. Data a => a -> r)
 everything k f x = foldl k (f x) (gmapQ (everything k f) x)
 
-variables :: GHC.RenamedSource -> [(GHC.SrcSpan, GHC.Name)]
+variables :: GHC.RenamedSource -> NameMap
 variables =
     everything (<|>) var
   where
     var term = case cast term of
         (Just (GHC.L sspan (GHC.HsVar sid))) -> pure (sspan, sid)
         _ -> empty
+
+matches :: Span -> GHC.SrcSpan -> Bool
+matches tspan (GHC.RealSrcSpan aspan)
+    | rs && cs && re && ce = True
+  where
+    rs = (posRow . spStart) tspan == GHC.srcSpanStartLine aspan
+    cs = (posCol . spStart) tspan == GHC.srcSpanStartCol aspan
+    re = (posRow . spEnd) tspan == GHC.srcSpanEndLine aspan
+    ce = (posCol . spEnd) tspan == GHC.srcSpanStartLine aspan
+matches _ _ = False

From cb3ece1a493eb444ccb61b6ad3c74e922184b63e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sat, 6 Jun 2015 21:43:15 +0200
Subject: [PATCH 016/109] Add dummy support for hyperlinking named tokens.

---
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 23 ++++++++++++++++---
 1 file changed, 20 insertions(+), 3 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 39d7d183d6..32d2c863d8 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -1,16 +1,20 @@
 module Haddock.Backends.Hyperlinker.Renderer where
 
 import Haddock.Backends.Hyperlinker.Parser
+import Haddock.Backends.Hyperlinker.Ast
+
+import qualified GHC
+import qualified Name as GHC
 
 import Data.Monoid
 import Text.XHtml (Html, HtmlAttr, (!))
 import qualified Text.XHtml as Html
 
-render :: Maybe FilePath -> [Token] -> Html
+render :: Maybe FilePath -> [RichToken] -> Html
 render css tokens = header css <> body tokens
 
-body :: [Token] -> Html
-body = Html.body . Html.pre . mconcat . map token
+body :: [RichToken] -> Html
+body = Html.body . Html.pre . mconcat . map richToken
 
 header :: Maybe FilePath -> Html
 header Nothing = Html.noHtml
@@ -23,6 +27,10 @@ header (Just css) =
         , Html.thetype "text/css"
         ]
 
+richToken :: RichToken -> Html
+richToken (RichToken t Nothing) = token t
+richToken (RichToken t (Just name)) = Html.anchor (token t) ! nameAttrs name
+
 token :: Token -> Html
 token (Token t v _) = Html.thespan (Html.toHtml v) ! tokenAttrs t
 
@@ -40,3 +48,12 @@ tokenAttrs TkComment = [Html.theclass "hs-comment"]
 tokenAttrs TkCpp = [Html.theclass "hs-cpp"]
 tokenAttrs TkPragma = [Html.theclass "hs-pragma"]
 tokenAttrs TkUnknown = []
+
+nameAttrs :: GHC.Name -> [HtmlAttr]
+nameAttrs name =
+    [ Html.href (maybe "" id mmod ++ "#" ++ ident)
+    , Html.theclass "varid-reference"
+    ]
+  where
+    mmod = GHC.moduleNameString . GHC.moduleName <$> GHC.nameModule_maybe name
+    ident = GHC.occNameString . GHC.nameOccName $ name

From 7d43b8a8c9538692beb91a4c3a485e82b40559ab Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sat, 6 Jun 2015 22:37:28 +0200
Subject: [PATCH 017/109] Fix span matcher bug causing wrong items being
 hyperlinked.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 031ddd5c58..7d88b7fbbd 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -48,5 +48,5 @@ matches tspan (GHC.RealSrcSpan aspan)
     rs = (posRow . spStart) tspan == GHC.srcSpanStartLine aspan
     cs = (posCol . spStart) tspan == GHC.srcSpanStartCol aspan
     re = (posRow . spEnd) tspan == GHC.srcSpanEndLine aspan
-    ce = (posCol . spEnd) tspan == GHC.srcSpanStartLine aspan
+    ce = (posCol . spEnd) tspan == GHC.srcSpanEndCol aspan
 matches _ _ = False

From 9a51a6d3f686736354e26137363ea979a5e38076 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sat, 6 Jun 2015 23:40:36 +0200
Subject: [PATCH 018/109] Constrain elements exported by hyperlinker modules.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs      | 5 ++++-
 haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs | 2 +-
 2 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 7d88b7fbbd..a24945ea58 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -1,6 +1,9 @@
 {-# LANGUAGE RankNTypes #-}
 
-module Haddock.Backends.Hyperlinker.Ast where
+module Haddock.Backends.Hyperlinker.Ast
+    ( enrich
+    , RichToken(..)
+    ) where
 
 import Haddock.Backends.Hyperlinker.Parser
 
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 32d2c863d8..3c6fe14fc0 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -1,4 +1,4 @@
-module Haddock.Backends.Hyperlinker.Renderer where
+module Haddock.Backends.Hyperlinker.Renderer (render) where
 
 import Haddock.Backends.Hyperlinker.Parser
 import Haddock.Backends.Hyperlinker.Ast

From 666af8d2f29c05d22bb5930d115c42509528bb90 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 7 Jun 2015 21:35:55 +0200
Subject: [PATCH 019/109] Add support for type token recognition.

---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs   | 35 +++++++---
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 64 ++++++++++++-------
 2 files changed, 68 insertions(+), 31 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index a24945ea58..0ccf010bdf 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -2,7 +2,7 @@
 
 module Haddock.Backends.Hyperlinker.Ast
     ( enrich
-    , RichToken(..)
+    , RichToken(..), RichTokenType(..), TokenDetails(..)
     ) where
 
 import Haddock.Backends.Hyperlinker.Parser
@@ -15,33 +15,52 @@ import Data.Maybe
 
 data RichToken = RichToken
     { rtkToken :: Token
-    , rtkName :: Maybe GHC.Name
+    , rtkDetails :: Maybe TokenDetails
     }
 
+data TokenDetails = TokenDetails
+    { rtkType :: RichTokenType
+    , rtkName :: GHC.Name
+    }
+
+data RichTokenType
+    = RtkVar
+    | RtkType
+
 enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
 enrich src =
     map $ \token -> RichToken
         { rtkToken = token
-        , rtkName = lookupBySpan (tkSpan token) nameMap
+        , rtkDetails = lookupBySpan (tkSpan token) detailsMap
         }
   where
-    nameMap = variables src
+    detailsMap = variables src ++ types src
 
-type NameMap = [(GHC.SrcSpan, GHC.Name)]
+type DetailsMap = [(GHC.SrcSpan, TokenDetails)]
 
-lookupBySpan :: Span -> NameMap -> Maybe GHC.Name
+lookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails
 lookupBySpan tspan = listToMaybe . map snd . filter (matches tspan . fst)
 
 everything :: (r -> r -> r) -> (forall a. Data a => a -> r)
            -> (forall a. Data a => a -> r)
 everything k f x = foldl k (f x) (gmapQ (everything k f) x)
 
-variables :: GHC.RenamedSource -> NameMap
+variables :: GHC.RenamedSource -> DetailsMap
 variables =
     everything (<|>) var
   where
     var term = case cast term of
-        (Just (GHC.L sspan (GHC.HsVar sid))) -> pure (sspan, sid)
+        (Just (GHC.L sspan (GHC.HsVar name))) ->
+            pure (sspan, TokenDetails RtkVar name)
+        _ -> empty
+
+types :: GHC.RenamedSource -> DetailsMap
+types =
+    everything (<|>) ty
+  where
+    ty term = case cast term of
+        (Just (GHC.L sspan (GHC.HsTyVar name))) ->
+            pure (sspan, TokenDetails RtkType name)
         _ -> empty
 
 matches :: Span -> GHC.SrcSpan -> Bool
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 3c6fe14fc0..c2bca43896 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -6,10 +6,14 @@ import Haddock.Backends.Hyperlinker.Ast
 import qualified GHC
 import qualified Name as GHC
 
+import Data.List
 import Data.Monoid
+
 import Text.XHtml (Html, HtmlAttr, (!))
 import qualified Text.XHtml as Html
 
+type StyleClass = String
+
 render :: Maybe FilePath -> [RichToken] -> Html
 render css tokens = header css <> body tokens
 
@@ -28,29 +32,43 @@ header (Just css) =
         ]
 
 richToken :: RichToken -> Html
-richToken (RichToken t Nothing) = token t
-richToken (RichToken t (Just name)) = Html.anchor (token t) ! nameAttrs name
-
-token :: Token -> Html
-token (Token t v _) = Html.thespan (Html.toHtml v) ! tokenAttrs t
-
-tokenAttrs :: TokenType -> [HtmlAttr]
-tokenAttrs TkIdentifier = [Html.theclass "hs-identifier"]
-tokenAttrs TkKeyword = [Html.theclass "hs-keyword"]
-tokenAttrs TkString = [Html.theclass "hs-string"]
-tokenAttrs TkChar = [Html.theclass "hs-char"]
-tokenAttrs TkNumber = [Html.theclass "hs-number"]
-tokenAttrs TkOperator = [Html.theclass "hs-operator"]
-tokenAttrs TkGlyph = [Html.theclass "hs-glyph"]
-tokenAttrs TkSpecial = [Html.theclass "hs-special"]
-tokenAttrs TkSpace = []
-tokenAttrs TkComment = [Html.theclass "hs-comment"]
-tokenAttrs TkCpp = [Html.theclass "hs-cpp"]
-tokenAttrs TkPragma = [Html.theclass "hs-pragma"]
-tokenAttrs TkUnknown = []
-
-nameAttrs :: GHC.Name -> [HtmlAttr]
-nameAttrs name =
+richToken (RichToken tok Nothing) =
+    tokenSpan tok ! attrs
+  where
+    attrs = [ multiclass . tokenStyle . tkType $ tok ]
+richToken (RichToken tok (Just det)) =
+    Html.anchor content ! (anchorAttrs . rtkName) det
+  where
+    content = tokenSpan tok ! [ multiclass style]
+    style = (tokenStyle . tkType) tok ++ (richTokenStyle . rtkType) det
+
+tokenSpan :: Token -> Html
+tokenSpan = Html.thespan . Html.toHtml . tkValue
+
+richTokenStyle :: RichTokenType -> [StyleClass]
+richTokenStyle RtkVar = ["hs-var"]
+richTokenStyle RtkType = ["hs-type"]
+
+tokenStyle :: TokenType -> [StyleClass]
+tokenStyle TkIdentifier = ["hs-identifier"]
+tokenStyle TkKeyword = ["hs-keyword"]
+tokenStyle TkString = ["hs-string"]
+tokenStyle TkChar = ["hs-char"]
+tokenStyle TkNumber = ["hs-number"]
+tokenStyle TkOperator = ["hs-operator"]
+tokenStyle TkGlyph = ["hs-glyph"]
+tokenStyle TkSpecial = ["hs-special"]
+tokenStyle TkSpace = []
+tokenStyle TkComment = ["hs-comment"]
+tokenStyle TkCpp = ["hs-cpp"]
+tokenStyle TkPragma = ["hs-pragma"]
+tokenStyle TkUnknown = []
+
+multiclass :: [StyleClass] -> HtmlAttr
+multiclass = Html.theclass . intercalate " "
+
+anchorAttrs :: GHC.Name -> [HtmlAttr]
+anchorAttrs name =
     [ Html.href (maybe "" id mmod ++ "#" ++ ident)
     , Html.theclass "varid-reference"
     ]

From 70656933ca6935bde0a00310f37440e02c3f21ff Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 8 Jun 2015 00:13:12 +0200
Subject: [PATCH 020/109] Add support for binding token recognition.

---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs   | 20 ++++++++++++++++++-
 .../Haddock/Backends/Hyperlinker/Renderer.hs  |  1 +
 2 files changed, 20 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 0ccf010bdf..19ebbe77bf 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Haddock.Backends.Hyperlinker.Ast
     ( enrich
@@ -26,6 +27,7 @@ data TokenDetails = TokenDetails
 data RichTokenType
     = RtkVar
     | RtkType
+    | RtkBind
 
 enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
 enrich src =
@@ -34,7 +36,7 @@ enrich src =
         , rtkDetails = lookupBySpan (tkSpan token) detailsMap
         }
   where
-    detailsMap = variables src ++ types src
+    detailsMap = variables src ++ types src ++ binds src
 
 type DetailsMap = [(GHC.SrcSpan, TokenDetails)]
 
@@ -45,6 +47,9 @@ everything :: (r -> r -> r) -> (forall a. Data a => a -> r)
            -> (forall a. Data a => a -> r)
 everything k f x = foldl k (f x) (gmapQ (everything k f) x)
 
+combine :: Alternative f => (forall a. Data a => a -> f r) -> (forall a. Data a => a -> f r) -> (forall a. Data a => a -> f r)
+combine f g x = f x <|> g x
+
 variables :: GHC.RenamedSource -> DetailsMap
 variables =
     everything (<|>) var
@@ -63,6 +68,19 @@ types =
             pure (sspan, TokenDetails RtkType name)
         _ -> empty
 
+binds :: GHC.RenamedSource -> DetailsMap
+binds =
+    everything (<|>) (fun `combine` pat)
+  where
+    fun term = case cast term of
+        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name)) ->
+            pure (sspan, TokenDetails RtkBind name)
+        _ -> empty
+    pat term = case cast term of
+        (Just (GHC.L sspan (GHC.VarPat name))) ->
+            pure (sspan, TokenDetails RtkBind name)
+        _ -> empty
+
 matches :: Span -> GHC.SrcSpan -> Bool
 matches tspan (GHC.RealSrcSpan aspan)
     | rs && cs && re && ce = True
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index c2bca43896..57851c2273 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -48,6 +48,7 @@ tokenSpan = Html.thespan . Html.toHtml . tkValue
 richTokenStyle :: RichTokenType -> [StyleClass]
 richTokenStyle RtkVar = ["hs-var"]
 richTokenStyle RtkType = ["hs-type"]
+richTokenStyle RtkBind = ["hs-bind"]
 
 tokenStyle :: TokenType -> [StyleClass]
 tokenStyle TkIdentifier = ["hs-identifier"]

From 21984e4cfcc076ce8cbee934028a1b37aaca930b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 8 Jun 2015 00:54:58 +0200
Subject: [PATCH 021/109] Implement go-to-definition mechanism for local
 bindings.

---
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 30 ++++++++++++++-----
 1 file changed, 23 insertions(+), 7 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 57851c2273..995e24e6d2 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -5,6 +5,7 @@ import Haddock.Backends.Hyperlinker.Ast
 
 import qualified GHC
 import qualified Name as GHC
+import qualified Unique as GHC
 
 import Data.List
 import Data.Monoid
@@ -37,7 +38,7 @@ richToken (RichToken tok Nothing) =
   where
     attrs = [ multiclass . tokenStyle . tkType $ tok ]
 richToken (RichToken tok (Just det)) =
-    Html.anchor content ! (anchorAttrs . rtkName) det
+    internalAnchor det . hyperlink det $ content
   where
     content = tokenSpan tok ! [ multiclass style]
     style = (tokenStyle . tkType) tok ++ (richTokenStyle . rtkType) det
@@ -48,7 +49,7 @@ tokenSpan = Html.thespan . Html.toHtml . tkValue
 richTokenStyle :: RichTokenType -> [StyleClass]
 richTokenStyle RtkVar = ["hs-var"]
 richTokenStyle RtkType = ["hs-type"]
-richTokenStyle RtkBind = ["hs-bind"]
+richTokenStyle RtkBind = []
 
 tokenStyle :: TokenType -> [StyleClass]
 tokenStyle TkIdentifier = ["hs-identifier"]
@@ -68,11 +69,26 @@ tokenStyle TkUnknown = []
 multiclass :: [StyleClass] -> HtmlAttr
 multiclass = Html.theclass . intercalate " "
 
-anchorAttrs :: GHC.Name -> [HtmlAttr]
-anchorAttrs name =
-    [ Html.href (maybe "" id mmod ++ "#" ++ ident)
-    , Html.theclass "varid-reference"
-    ]
+internalAnchor :: TokenDetails -> Html -> Html
+internalAnchor (TokenDetails RtkBind name) content =
+    Html.anchor content ! [ Html.name $ internalAnchorIdent name ]
+internalAnchor _ content = content
+
+internalAnchorIdent :: GHC.Name -> String
+internalAnchorIdent = ("local-" ++) . show . GHC.getKey . GHC.nameUnique
+
+hyperlink :: TokenDetails -> Html -> Html
+hyperlink (TokenDetails _ name) = if GHC.isInternalName name
+    then internalHyperlink name
+    else externalHyperlink name
+
+internalHyperlink :: GHC.Name -> Html -> Html
+internalHyperlink name content =
+    Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ]
+
+externalHyperlink :: GHC.Name -> Html -> Html
+externalHyperlink name content =
+    Html.anchor content ! [ Html.href $ maybe "" id mmod ++ "#" ++ ident ]
   where
     mmod = GHC.moduleNameString . GHC.moduleName <$> GHC.nameModule_maybe name
     ident = GHC.occNameString . GHC.nameOccName $ name

From c84a3ef8ebca5fb396ee9dc8cb2654f7891f5c0e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 8 Jun 2015 14:12:58 +0200
Subject: [PATCH 022/109] Implement module export- and import-list item
 hyperlinking.

---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs   | 20 ++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 19ebbe77bf..2325aa215a 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -36,7 +36,12 @@ enrich src =
         , rtkDetails = lookupBySpan (tkSpan token) detailsMap
         }
   where
-    detailsMap = variables src ++ types src ++ binds src
+    detailsMap = concat
+        [ variables src
+        , types src
+        , binds src
+        , imports src
+        ]
 
 type DetailsMap = [(GHC.SrcSpan, TokenDetails)]
 
@@ -81,6 +86,19 @@ binds =
             pure (sspan, TokenDetails RtkBind name)
         _ -> empty
 
+imports :: GHC.RenamedSource -> DetailsMap
+imports =
+    everything (<|>) ie
+  where
+    ie term = case cast term of
+        (Just (GHC.IEVar v)) -> pure $ var v
+        (Just (GHC.IEThingAbs t)) -> pure $ typ t
+        (Just (GHC.IEThingAll t)) -> pure $ typ t
+        (Just (GHC.IEThingWith t vs)) -> [typ t] ++ map var vs
+        _ -> empty
+    typ (GHC.L sspan name) = (sspan, TokenDetails RtkType name)
+    var (GHC.L sspan name) = (sspan, TokenDetails RtkVar name)
+
 matches :: Span -> GHC.SrcSpan -> Bool
 matches tspan (GHC.RealSrcSpan aspan)
     | rs && cs && re && ce = True

From fab61bb80c2d8059e91aece7677cf349cd34a8db Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 8 Jun 2015 15:05:35 +0200
Subject: [PATCH 023/109] Fix span matching to allow parenthesized operators
 hyperlinking.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 2325aa215a..05d6a52ef6 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -101,10 +101,10 @@ imports =
 
 matches :: Span -> GHC.SrcSpan -> Bool
 matches tspan (GHC.RealSrcSpan aspan)
-    | rs && cs && re && ce = True
+    | saspan <= stspan && etspan <= easpan = True
   where
-    rs = (posRow . spStart) tspan == GHC.srcSpanStartLine aspan
-    cs = (posCol . spStart) tspan == GHC.srcSpanStartCol aspan
-    re = (posRow . spEnd) tspan == GHC.srcSpanEndLine aspan
-    ce = (posCol . spEnd) tspan == GHC.srcSpanEndCol aspan
+    stspan = (posRow . spStart $ tspan, posCol . spStart $ tspan)
+    etspan = (posRow . spEnd $ tspan, posCol . spEnd $ tspan)
+    saspan = (GHC.srcSpanStartLine aspan, GHC.srcSpanStartCol aspan)
+    easpan = (GHC.srcSpanEndLine aspan, GHC.srcSpanEndCol aspan)
 matches _ _ = False

From b31513dbacb48102b4c5d2fd6de1982161d81fae Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 8 Jun 2015 15:16:06 +0200
Subject: [PATCH 024/109] Fix weird hyperlinking of parenthesized operators.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs    | 7 ++++++-
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 1 +
 2 files changed, 7 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 05d6a52ef6..2749096e09 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -33,7 +33,7 @@ enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
 enrich src =
     map $ \token -> RichToken
         { rtkToken = token
-        , rtkDetails = lookupBySpan (tkSpan token) detailsMap
+        , rtkDetails = enrichToken token detailsMap
         }
   where
     detailsMap = concat
@@ -45,6 +45,11 @@ enrich src =
 
 type DetailsMap = [(GHC.SrcSpan, TokenDetails)]
 
+enrichToken :: Token -> DetailsMap -> Maybe TokenDetails
+enrichToken (Token typ _ spn) dm
+    | typ `elem` [TkIdentifier, TkOperator] = lookupBySpan spn dm
+enrichToken _ _ = Nothing
+
 lookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails
 lookupBySpan tspan = listToMaybe . map snd . filter (matches tspan . fst)
 
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 0e1ad5b250..70a692795d 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -37,6 +37,7 @@ data TokenType
     | TkCpp
     | TkPragma
     | TkUnknown
+    deriving (Eq)
 
 parse :: String -> [Token]
 parse = tokenize . tag . chunk

From 162b02ed6f50709ea203bf7706eee5804e455419 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 12 Jun 2015 01:03:13 +0200
Subject: [PATCH 025/109] Add support for type declaration anchors.

---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs   | 21 ++++++++++++++-----
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 14 ++++++++++---
 2 files changed, 27 insertions(+), 8 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 2749096e09..39bbacf56d 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -28,6 +28,7 @@ data RichTokenType
     = RtkVar
     | RtkType
     | RtkBind
+    | RtkDecl
 
 enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
 enrich src =
@@ -36,11 +37,12 @@ enrich src =
         , rtkDetails = enrichToken token detailsMap
         }
   where
-    detailsMap = concat
-        [ variables src
-        , types src
-        , binds src
-        , imports src
+    detailsMap = concatMap ($ src)
+        [ variables
+        , types
+        , binds
+        , imports
+        , decls
         ]
 
 type DetailsMap = [(GHC.SrcSpan, TokenDetails)]
@@ -91,6 +93,15 @@ binds =
             pure (sspan, TokenDetails RtkBind name)
         _ -> empty
 
+decls :: GHC.RenamedSource -> DetailsMap
+decls (group, _, _, _) = concatMap ($ group)
+    [ map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
+    ]
+  where
+    typ (GHC.L _ t) =
+        let (GHC.L sspan name) = GHC.tcdLName t
+        in (sspan, TokenDetails RtkDecl name)
+
 imports :: GHC.RenamedSource -> DetailsMap
 imports =
     everything (<|>) ie
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 995e24e6d2..b7cc5aeb6b 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -38,7 +38,7 @@ richToken (RichToken tok Nothing) =
   where
     attrs = [ multiclass . tokenStyle . tkType $ tok ]
 richToken (RichToken tok (Just det)) =
-    internalAnchor det . hyperlink det $ content
+    externalAnchor det . internalAnchor det . hyperlink det $ content
   where
     content = tokenSpan tok ! [ multiclass style]
     style = (tokenStyle . tkType) tok ++ (richTokenStyle . rtkType) det
@@ -49,7 +49,7 @@ tokenSpan = Html.thespan . Html.toHtml . tkValue
 richTokenStyle :: RichTokenType -> [StyleClass]
 richTokenStyle RtkVar = ["hs-var"]
 richTokenStyle RtkType = ["hs-type"]
-richTokenStyle RtkBind = []
+richTokenStyle _ = []
 
 tokenStyle :: TokenType -> [StyleClass]
 tokenStyle TkIdentifier = ["hs-identifier"]
@@ -69,11 +69,19 @@ tokenStyle TkUnknown = []
 multiclass :: [StyleClass] -> HtmlAttr
 multiclass = Html.theclass . intercalate " "
 
+externalAnchor :: TokenDetails -> Html -> Html
+externalAnchor (TokenDetails RtkDecl name) content =
+    Html.anchor content ! [ Html.name $ externalAnchorIdent name ]
+externalAnchor _ content = content
+
 internalAnchor :: TokenDetails -> Html -> Html
 internalAnchor (TokenDetails RtkBind name) content =
     Html.anchor content ! [ Html.name $ internalAnchorIdent name ]
 internalAnchor _ content = content
 
+externalAnchorIdent :: GHC.Name -> String
+externalAnchorIdent = GHC.occNameString . GHC.nameOccName
+
 internalAnchorIdent :: GHC.Name -> String
 internalAnchorIdent = ("local-" ++) . show . GHC.getKey . GHC.nameUnique
 
@@ -91,4 +99,4 @@ externalHyperlink name content =
     Html.anchor content ! [ Html.href $ maybe "" id mmod ++ "#" ++ ident ]
   where
     mmod = GHC.moduleNameString . GHC.moduleName <$> GHC.nameModule_maybe name
-    ident = GHC.occNameString . GHC.nameOccName $ name
+    ident = externalAnchorIdent name

From c6786894f71809ecfa377a44beab0771a3bc7985 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 12 Jun 2015 01:36:49 +0200
Subject: [PATCH 026/109] Add support for top-level function declaration
 anchors.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 39bbacf56d..cb9508ef76 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -40,9 +40,9 @@ enrich src =
     detailsMap = concatMap ($ src)
         [ variables
         , types
+        , decls
         , binds
         , imports
-        , decls
         ]
 
 type DetailsMap = [(GHC.SrcSpan, TokenDetails)]
@@ -96,11 +96,16 @@ binds =
 decls :: GHC.RenamedSource -> DetailsMap
 decls (group, _, _, _) = concatMap ($ group)
     [ map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
+    , everything (<|>) fun
     ]
   where
     typ (GHC.L _ t) =
         let (GHC.L sspan name) = GHC.tcdLName t
         in (sspan, TokenDetails RtkDecl name)
+    fun term = case cast term of
+        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name))
+            | GHC.isExternalName name -> pure (sspan, TokenDetails RtkDecl name)
+        _ -> empty
 
 imports :: GHC.RenamedSource -> DetailsMap
 imports =

From 1064953c6590c05303c6cbd2230b9e13d3ba1376 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 12 Jun 2015 10:57:30 +0200
Subject: [PATCH 027/109] Fix external anchors to contain HTML file extension.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index b7cc5aeb6b..99a0f3370c 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -96,7 +96,7 @@ internalHyperlink name content =
 
 externalHyperlink :: GHC.Name -> Html -> Html
 externalHyperlink name content =
-    Html.anchor content ! [ Html.href $ maybe "" id mmod ++ "#" ++ ident ]
+    Html.anchor content ! [ Html.href $ maybe "" id mmod ++ ".html#" ++ ident ]
   where
     mmod = GHC.moduleNameString . GHC.moduleName <$> GHC.nameModule_maybe name
     ident = externalAnchorIdent name

From 60db14903e01f4c26f179230c7b6190a7b99fb51 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 17 Jun 2015 21:49:46 +0200
Subject: [PATCH 028/109] Refactor the way AST names are handled within
 detailed tokens.

---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs   | 37 ++++++++++---------
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 17 +++++----
 2 files changed, 29 insertions(+), 25 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index cb9508ef76..3c07ff3c19 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -3,7 +3,7 @@
 
 module Haddock.Backends.Hyperlinker.Ast
     ( enrich
-    , RichToken(..), RichTokenType(..), TokenDetails(..)
+    , RichToken(..), TokenDetails(..), rtkName
     ) where
 
 import Haddock.Backends.Hyperlinker.Parser
@@ -19,16 +19,17 @@ data RichToken = RichToken
     , rtkDetails :: Maybe TokenDetails
     }
 
-data TokenDetails = TokenDetails
-    { rtkType :: RichTokenType
-    , rtkName :: GHC.Name
-    }
+data TokenDetails
+    = RtkVar GHC.Name
+    | RtkType GHC.Name
+    | RtkBind GHC.Name
+    | RtkDecl GHC.Name
 
-data RichTokenType
-    = RtkVar
-    | RtkType
-    | RtkBind
-    | RtkDecl
+rtkName :: TokenDetails -> GHC.Name
+rtkName (RtkVar name) = name
+rtkName (RtkType name) = name
+rtkName (RtkBind name) = name
+rtkName (RtkDecl name) = name
 
 enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
 enrich src =
@@ -68,7 +69,7 @@ variables =
   where
     var term = case cast term of
         (Just (GHC.L sspan (GHC.HsVar name))) ->
-            pure (sspan, TokenDetails RtkVar name)
+            pure (sspan, RtkVar name)
         _ -> empty
 
 types :: GHC.RenamedSource -> DetailsMap
@@ -77,7 +78,7 @@ types =
   where
     ty term = case cast term of
         (Just (GHC.L sspan (GHC.HsTyVar name))) ->
-            pure (sspan, TokenDetails RtkType name)
+            pure (sspan, RtkType name)
         _ -> empty
 
 binds :: GHC.RenamedSource -> DetailsMap
@@ -86,11 +87,11 @@ binds =
   where
     fun term = case cast term of
         (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name)) ->
-            pure (sspan, TokenDetails RtkBind name)
+            pure (sspan, RtkBind name)
         _ -> empty
     pat term = case cast term of
         (Just (GHC.L sspan (GHC.VarPat name))) ->
-            pure (sspan, TokenDetails RtkBind name)
+            pure (sspan, RtkBind name)
         _ -> empty
 
 decls :: GHC.RenamedSource -> DetailsMap
@@ -101,10 +102,10 @@ decls (group, _, _, _) = concatMap ($ group)
   where
     typ (GHC.L _ t) =
         let (GHC.L sspan name) = GHC.tcdLName t
-        in (sspan, TokenDetails RtkDecl name)
+        in (sspan, RtkDecl name)
     fun term = case cast term of
         (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name))
-            | GHC.isExternalName name -> pure (sspan, TokenDetails RtkDecl name)
+            | GHC.isExternalName name -> pure (sspan, RtkDecl name)
         _ -> empty
 
 imports :: GHC.RenamedSource -> DetailsMap
@@ -117,8 +118,8 @@ imports =
         (Just (GHC.IEThingAll t)) -> pure $ typ t
         (Just (GHC.IEThingWith t vs)) -> [typ t] ++ map var vs
         _ -> empty
-    typ (GHC.L sspan name) = (sspan, TokenDetails RtkType name)
-    var (GHC.L sspan name) = (sspan, TokenDetails RtkVar name)
+    typ (GHC.L sspan name) = (sspan, RtkType name)
+    var (GHC.L sspan name) = (sspan, RtkVar name)
 
 matches :: Span -> GHC.SrcSpan -> Bool
 matches tspan (GHC.RealSrcSpan aspan)
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 99a0f3370c..e08d897474 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -41,14 +41,14 @@ richToken (RichToken tok (Just det)) =
     externalAnchor det . internalAnchor det . hyperlink det $ content
   where
     content = tokenSpan tok ! [ multiclass style]
-    style = (tokenStyle . tkType) tok ++ (richTokenStyle . rtkType) det
+    style = (tokenStyle . tkType) tok ++ richTokenStyle det
 
 tokenSpan :: Token -> Html
 tokenSpan = Html.thespan . Html.toHtml . tkValue
 
-richTokenStyle :: RichTokenType -> [StyleClass]
-richTokenStyle RtkVar = ["hs-var"]
-richTokenStyle RtkType = ["hs-type"]
+richTokenStyle :: TokenDetails -> [StyleClass]
+richTokenStyle (RtkVar _) = ["hs-var"]
+richTokenStyle (RtkType _) = ["hs-type"]
 richTokenStyle _ = []
 
 tokenStyle :: TokenType -> [StyleClass]
@@ -70,12 +70,12 @@ multiclass :: [StyleClass] -> HtmlAttr
 multiclass = Html.theclass . intercalate " "
 
 externalAnchor :: TokenDetails -> Html -> Html
-externalAnchor (TokenDetails RtkDecl name) content =
+externalAnchor (RtkDecl name) content =
     Html.anchor content ! [ Html.name $ externalAnchorIdent name ]
 externalAnchor _ content = content
 
 internalAnchor :: TokenDetails -> Html -> Html
-internalAnchor (TokenDetails RtkBind name) content =
+internalAnchor (RtkBind name) content =
     Html.anchor content ! [ Html.name $ internalAnchorIdent name ]
 internalAnchor _ content = content
 
@@ -86,9 +86,12 @@ internalAnchorIdent :: GHC.Name -> String
 internalAnchorIdent = ("local-" ++) . show . GHC.getKey . GHC.nameUnique
 
 hyperlink :: TokenDetails -> Html -> Html
-hyperlink (TokenDetails _ name) = if GHC.isInternalName name
+hyperlink details =
+    if GHC.isInternalName $ name
     then internalHyperlink name
     else externalHyperlink name
+  where
+    name = rtkName details
 
 internalHyperlink :: GHC.Name -> Html -> Html
 internalHyperlink name content =

From a85224a68b51b70035446ad8e5565d571c4a10d4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 17 Jun 2015 22:22:49 +0200
Subject: [PATCH 029/109] Implement hyperlinking of imported module names.

---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs   | 19 ++++++++-----
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 28 +++++++++++--------
 2 files changed, 29 insertions(+), 18 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 3c07ff3c19..10389958fc 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -24,12 +24,14 @@ data TokenDetails
     | RtkType GHC.Name
     | RtkBind GHC.Name
     | RtkDecl GHC.Name
+    | RtkModule GHC.ModuleName
 
-rtkName :: TokenDetails -> GHC.Name
-rtkName (RtkVar name) = name
-rtkName (RtkType name) = name
-rtkName (RtkBind name) = name
-rtkName (RtkDecl name) = name
+rtkName :: TokenDetails -> Either GHC.Name GHC.ModuleName
+rtkName (RtkVar name) = Left name
+rtkName (RtkType name) = Left name
+rtkName (RtkBind name) = Left name
+rtkName (RtkDecl name) = Left name
+rtkName (RtkModule name) = Right name
 
 enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
 enrich src =
@@ -109,8 +111,8 @@ decls (group, _, _, _) = concatMap ($ group)
         _ -> empty
 
 imports :: GHC.RenamedSource -> DetailsMap
-imports =
-    everything (<|>) ie
+imports src@(_, imps, _, _) =
+    everything (<|>) ie src ++ map (imp . GHC.unLoc) imps
   where
     ie term = case cast term of
         (Just (GHC.IEVar v)) -> pure $ var v
@@ -120,6 +122,9 @@ imports =
         _ -> empty
     typ (GHC.L sspan name) = (sspan, RtkType name)
     var (GHC.L sspan name) = (sspan, RtkVar name)
+    imp idecl =
+        let (GHC.L sspan name) = GHC.ideclName idecl
+        in (sspan, RtkModule name)
 
 matches :: Span -> GHC.SrcSpan -> Bool
 matches tspan (GHC.RealSrcSpan aspan)
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index e08d897474..7052475903 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -8,6 +8,7 @@ import qualified Name as GHC
 import qualified Unique as GHC
 
 import Data.List
+import Data.Maybe
 import Data.Monoid
 
 import Text.XHtml (Html, HtmlAttr, (!))
@@ -86,20 +87,25 @@ internalAnchorIdent :: GHC.Name -> String
 internalAnchorIdent = ("local-" ++) . show . GHC.getKey . GHC.nameUnique
 
 hyperlink :: TokenDetails -> Html -> Html
-hyperlink details =
-    if GHC.isInternalName $ name
-    then internalHyperlink name
-    else externalHyperlink name
-  where
-    name = rtkName details
+hyperlink details = case rtkName details of
+    Left name ->
+        if GHC.isInternalName name
+        then internalHyperlink name
+        else externalHyperlink mname (Just name)
+      where
+        mname = GHC.moduleName <$> GHC.nameModule_maybe name
+    Right name -> externalHyperlink (Just name) Nothing
 
 internalHyperlink :: GHC.Name -> Html -> Html
 internalHyperlink name content =
     Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ]
 
-externalHyperlink :: GHC.Name -> Html -> Html
-externalHyperlink name content =
-    Html.anchor content ! [ Html.href $ maybe "" id mmod ++ ".html#" ++ ident ]
+externalHyperlink :: Maybe GHC.ModuleName -> Maybe GHC.Name -> Html -> Html
+externalHyperlink mmname miname content =
+    Html.anchor content ! [ Html.href $ path ++ anchor ]
   where
-    mmod = GHC.moduleNameString . GHC.moduleName <$> GHC.nameModule_maybe name
-    ident = externalAnchorIdent name
+    path = fromMaybe "" $ modulePath <$> mmname
+    anchor = fromMaybe "" $ ("#" ++) . externalAnchorIdent <$> miname
+
+modulePath :: GHC.ModuleName -> String
+modulePath name = GHC.moduleNameString name ++ ".html"

From ebd60c5cd0c3642c2d5542c0e126be0a4ec111d9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 17 Jun 2015 23:43:31 +0200
Subject: [PATCH 030/109] Fix parsing of single line comments with broken up
 newlines.

---
 .../src/Haddock/Backends/Hyperlinker/Parser.hs       | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 70a692795d..3ecfc7e7a4 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -47,13 +47,23 @@ chunk [] = []
 chunk str@(c:_)
     | isSpace c = chunk' $ span isSpace str
 chunk str
-    | "--" `isPrefixOf` str = chunk' $ span (not . (== '\n')) str
+    | "--" `isPrefixOf` str = chunk' $ spanToNewline str
     | "{-" `isPrefixOf` str = chunk' $ chunkComment 0 str
     | otherwise = chunk' $ head $ lex str
 
 chunk' :: (String, String) -> [String]
 chunk' (c, rest) = c:(chunk rest)
 
+spanToNewline :: String -> (String, String)
+spanToNewline [] = ([], [])
+spanToNewline ('\\':'\n':str) =
+    let (str', rest) = spanToNewline str
+    in ('\\':'\n':str', rest)
+spanToNewline ('\n':str) = ("\n", str)
+spanToNewline (c:str) =
+    let (str', rest) = spanToNewline str
+    in (c:str', rest)
+
 chunkComment :: Int -> String -> (String, String)
 chunkComment _ [] = ("", "")
 chunkComment depth ('{':'-':str) =

From a7888aefa4011d919b887ff31fcf8651af5632be Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 18 Jun 2015 00:25:56 +0200
Subject: [PATCH 031/109] Fix bug with improper newline handling.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 3ecfc7e7a4..bfee4a7f8d 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -59,7 +59,7 @@ spanToNewline [] = ([], [])
 spanToNewline ('\\':'\n':str) =
     let (str', rest) = spanToNewline str
     in ('\\':'\n':str', rest)
-spanToNewline ('\n':str) = ("\n", str)
+spanToNewline str@('\n':_) = ("", str)
 spanToNewline (c:str) =
     let (str', rest) = spanToNewline str
     in (c:str', rest)

From 45cc27fe79492a7b921574796a7ea8fdac4c5af2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 18 Jun 2015 14:29:59 +0200
Subject: [PATCH 032/109] Fix issues with escaped newlines in comments.

---
 .../src/Haddock/Backends/Hyperlinker/Parser.hs      | 13 +++++--------
 1 file changed, 5 insertions(+), 8 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index bfee4a7f8d..fa5a58b372 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -82,14 +82,11 @@ tag :: [String] -> [(Span, String)]
 tag =
     reverse . snd . foldl aux (Position 1 1, [])
   where
-    aux (pos, cs) c =
-        let pos' = move pos c
-        in (pos', ((Span pos pos', c):cs))
-    move pos str@(c:_)
-        | isSpace c = foldl move' pos str
-    move pos str = pos { posCol = posCol pos + length str }
-    move' pos '\n' = pos { posRow = posRow pos + 1, posCol = 1 }
-    move' pos _ = pos { posCol = posCol pos + 1 }
+    aux (pos, cs) str =
+        let pos' = foldl move pos str
+        in (pos', (Span pos pos', str):cs)
+    move pos '\n' = pos { posRow = posRow pos + 1, posCol = 1 }
+    move pos _ = pos { posCol = posCol pos + 1 }
 
 tokenize :: [(Span, String)] -> [Token]
 tokenize =

From 61942ce564edcb3c0a64051042c8ed850f2090bd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 18 Jun 2015 15:19:59 +0200
Subject: [PATCH 033/109] Add support for parsing C preprocessor macros.

---
 .../Haddock/Backends/Hyperlinker/Parser.hs    | 20 +++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index fa5a58b372..7f40816585 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -6,6 +6,7 @@ module Haddock.Backends.Hyperlinker.Parser
 
 import Data.Char
 import Data.List
+import Data.Maybe
 
 data Token = Token
     { tkType :: TokenType
@@ -45,14 +46,15 @@ parse = tokenize . tag . chunk
 chunk :: String -> [String]
 chunk [] = []
 chunk str@(c:_)
-    | isSpace c = chunk' $ span isSpace str
+    | isSpace c =
+        let (space, mcpp, rest) = spanSpaceOrCpp str
+        in [space] ++ maybeToList mcpp ++ chunk rest
 chunk str
     | "--" `isPrefixOf` str = chunk' $ spanToNewline str
     | "{-" `isPrefixOf` str = chunk' $ chunkComment 0 str
     | otherwise = chunk' $ head $ lex str
-
-chunk' :: (String, String) -> [String]
-chunk' (c, rest) = c:(chunk rest)
+  where
+    chunk' (c, rest) = c:(chunk rest)
 
 spanToNewline :: String -> (String, String)
 spanToNewline [] = ([], [])
@@ -64,6 +66,16 @@ spanToNewline (c:str) =
     let (str', rest) = spanToNewline str
     in (c:str', rest)
 
+spanSpaceOrCpp :: String -> (String, Maybe String, String)
+spanSpaceOrCpp ('\n':'#':str) =
+    let (str', rest) = spanToNewline str
+    in ("\n", Just $ '#':str', rest)
+spanSpaceOrCpp (c:str')
+    | isSpace c =
+        let (space, mcpp, rest) = spanSpaceOrCpp str'
+        in (c:space, mcpp, rest)
+spanSpaceOrCpp str = ("", Nothing, str)
+
 chunkComment :: Int -> String -> (String, String)
 chunkComment _ [] = ("", "")
 chunkComment depth ('{':'-':str) =

From 416c384a981593005c9c6bf87ac27b7c2f9b8695 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 21 Jun 2015 23:48:03 +0200
Subject: [PATCH 034/109] Add some documentation for parser module of source
 hyperlinker.

---
 .../Haddock/Backends/Hyperlinker/Parser.hs    | 39 +++++++++++++++++++
 1 file changed, 39 insertions(+)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 7f40816585..6e195dba5b 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -40,9 +40,20 @@ data TokenType
     | TkUnknown
     deriving (Eq)
 
+-- | Turn source code string into a stream of more descriptive tokens.
+--
+-- Result should retain original file layout (including comments, whitespace,
+-- etc.), i.e. the following "law" should hold:
+--
+-- @concat . map 'tkValue' . 'parse' = id@
 parse :: String -> [Token]
 parse = tokenize . tag . chunk
 
+-- | Split raw source string to more meaningful chunks.
+--
+-- This is the initial stage of tokenization process. Each chunk is either
+-- a comment (including comment delimiters), a whitespace string, preprocessor
+-- macro (and all its content until the end of a line) or valid Haskell lexeme.
 chunk :: String -> [String]
 chunk [] = []
 chunk str@(c:_)
@@ -56,6 +67,11 @@ chunk str
   where
     chunk' (c, rest) = c:(chunk rest)
 
+-- | Split input to "first line" string and the rest of it.
+--
+-- Ideally, this should be done simply with @'break' (== '\n')@. However,
+-- Haskell also allows line-unbreaking (or whatever it is called) so things
+-- are not as simple and this function deals with that.
 spanToNewline :: String -> (String, String)
 spanToNewline [] = ([], [])
 spanToNewline ('\\':'\n':str) =
@@ -66,6 +82,16 @@ spanToNewline (c:str) =
     let (str', rest) = spanToNewline str
     in (c:str', rest)
 
+-- | Split input to whitespace string, (optional) preprocessor directive and
+-- the rest of it.
+--
+-- Again, using something like @'span' 'isSpace'@ would be nice to chunk input
+-- to whitespace. The problem is with /#/ symbol - if it is placed at the very
+-- beginning of a line, it should be recognized as preprocessor macro. In any
+-- other case, it is ordinary Haskell symbol and can be used to declare
+-- operators. Hence, while dealing with whitespace we also check whether there
+-- happens to be /#/ symbol just after a newline character - if that is the
+-- case, we begin treating the whole line as preprocessor macro.
 spanSpaceOrCpp :: String -> (String, Maybe String, String)
 spanSpaceOrCpp ('\n':'#':str) =
     let (str', rest) = spanToNewline str
@@ -76,6 +102,10 @@ spanSpaceOrCpp (c:str')
         in (c:space, mcpp, rest)
 spanSpaceOrCpp str = ("", Nothing, str)
 
+-- | Split input to comment content (including delimiters) and the rest.
+--
+-- Again, some more logic than simple 'span' is required because of Haskell
+-- comment nesting policy.
 chunkComment :: Int -> String -> (String, String)
 chunkComment _ [] = ("", "")
 chunkComment depth ('{':'-':str) =
@@ -90,6 +120,7 @@ chunkComment depth (e:str) =
     let (c, rest) = chunkComment depth str
     in (e:c, rest)
 
+-- | Assign source location for each chunk in given stream.
 tag :: [String] -> [(Span, String)]
 tag =
     reverse . snd . foldl aux (Position 1 1, [])
@@ -100,6 +131,7 @@ tag =
     move pos '\n' = pos { posRow = posRow pos + 1, posCol = 1 }
     move pos _ = pos { posCol = posCol pos + 1 }
 
+-- | Turn unrecognised chunk stream to more descriptive token stream.
 tokenize :: [(Span, String)] -> [Token]
 tokenize =
     map aux
@@ -110,6 +142,13 @@ tokenize =
         , tkSpan = sp
         }
 
+-- | Classify given string as appropriate Haskell token.
+--
+-- This method is based on Haskell 98 Report lexical structure description:
+-- https://www.haskell.org/onlinereport/lexemes.html
+--
+-- However, this is probably far from being perfect and most probably does not
+-- handle correctly all corner cases.
 classify :: String -> TokenType
 classify str
     | "--" `isPrefixOf` str = TkComment

From 937a6011d253a77cda98ec112a839cd08ac7e7ca Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 22 Jun 2015 00:20:44 +0200
Subject: [PATCH 035/109] Add some documentation for AST module of source
 hyperlinker.

---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs   | 56 +++++++++++++++----
 1 file changed, 46 insertions(+), 10 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 10389958fc..275f10e97b 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -33,6 +33,7 @@ rtkName (RtkBind name) = Left name
 rtkName (RtkDecl name) = Left name
 rtkName (RtkModule name) = Right name
 
+-- | Add more detailed information to token stream using GHC API.
 enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
 enrich src =
     map $ \token -> RichToken
@@ -48,23 +49,24 @@ enrich src =
         , imports
         ]
 
+-- | A map containing association between source locations and "details" of
+-- this location.
+--
+-- For the time being, it is just a list of pairs. However, looking up things
+-- in such structure has linear complexity. We cannot use any hashmap-like
+-- stuff because source locations are not ordered. In the future, this should
+-- be replaced with interval tree data structure.
 type DetailsMap = [(GHC.SrcSpan, TokenDetails)]
 
+lookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails
+lookupBySpan tspan = listToMaybe . map snd . filter (matches tspan . fst)
+
 enrichToken :: Token -> DetailsMap -> Maybe TokenDetails
 enrichToken (Token typ _ spn) dm
     | typ `elem` [TkIdentifier, TkOperator] = lookupBySpan spn dm
 enrichToken _ _ = Nothing
 
-lookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails
-lookupBySpan tspan = listToMaybe . map snd . filter (matches tspan . fst)
-
-everything :: (r -> r -> r) -> (forall a. Data a => a -> r)
-           -> (forall a. Data a => a -> r)
-everything k f x = foldl k (f x) (gmapQ (everything k f) x)
-
-combine :: Alternative f => (forall a. Data a => a -> f r) -> (forall a. Data a => a -> f r) -> (forall a. Data a => a -> f r)
-combine f g x = f x <|> g x
-
+-- | Obtain details map for variables ("normally" used identifiers).
 variables :: GHC.RenamedSource -> DetailsMap
 variables =
     everything (<|>) var
@@ -74,6 +76,7 @@ variables =
             pure (sspan, RtkVar name)
         _ -> empty
 
+-- | Obtain details map for types.
 types :: GHC.RenamedSource -> DetailsMap
 types =
     everything (<|>) ty
@@ -83,6 +86,11 @@ types =
             pure (sspan, RtkType name)
         _ -> empty
 
+-- | Obtain details map for identifier bindings.
+--
+-- That includes both identifiers bound by pattern matching or declared using
+-- ordinary assignment (in top-level declarations, let-expressions and where
+-- clauses).
 binds :: GHC.RenamedSource -> DetailsMap
 binds =
     everything (<|>) (fun `combine` pat)
@@ -96,6 +104,7 @@ binds =
             pure (sspan, RtkBind name)
         _ -> empty
 
+-- | Obtain details map for top-level declarations.
 decls :: GHC.RenamedSource -> DetailsMap
 decls (group, _, _, _) = concatMap ($ group)
     [ map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
@@ -110,6 +119,10 @@ decls (group, _, _, _) = concatMap ($ group)
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)
         _ -> empty
 
+-- | Obtain details map for import declarations.
+--
+-- This map also includes type and variable details for items in export and
+-- import lists.
 imports :: GHC.RenamedSource -> DetailsMap
 imports src@(_, imps, _, _) =
     everything (<|>) ie src ++ map (imp . GHC.unLoc) imps
@@ -126,6 +139,15 @@ imports src@(_, imps, _, _) =
         let (GHC.L sspan name) = GHC.ideclName idecl
         in (sspan, RtkModule name)
 
+-- | Check whether token stream span matches GHC source span.
+--
+-- Currently, it is implemented as checking whether "our" span is contained
+-- in GHC span. The reason for that is because GHC span are generally wider
+-- and may spread across couple tokens. For example, @(>>=)@ consists of three
+-- tokens: @(@, @>>=@, @)@, but GHC source span associated with @>>=@ variable
+-- contains @(@ and @)@. Similarly, qualified identifiers like @Foo.Bar.quux@
+-- are tokenized as @Foo@, @.@, @Bar@, @.@, @quux@ but GHC source span
+-- associated with @quux@ contains all five elements.
 matches :: Span -> GHC.SrcSpan -> Bool
 matches tspan (GHC.RealSrcSpan aspan)
     | saspan <= stspan && etspan <= easpan = True
@@ -135,3 +157,17 @@ matches tspan (GHC.RealSrcSpan aspan)
     saspan = (GHC.srcSpanStartLine aspan, GHC.srcSpanStartCol aspan)
     easpan = (GHC.srcSpanEndLine aspan, GHC.srcSpanEndCol aspan)
 matches _ _ = False
+
+-- | Perform a query on each level of a tree.
+--
+-- This is stolen directly from SYB package and copied here to not introduce
+-- additional dependencies.
+everything :: (r -> r -> r) -> (forall a. Data a => a -> r)
+           -> (forall a. Data a => a -> r)
+everything k f x = foldl k (f x) (gmapQ (everything k f) x)
+
+-- | Combine two queries into one using alternative combinator.
+combine :: Alternative f => (forall a. Data a => a -> f r)
+                         -> (forall a. Data a => a -> f r)
+                         -> (forall a. Data a => a -> f r)
+combine f g x = f x <|> g x

From ce4b5607f84506e5aafd1994e02300c2e3ee475d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 22 Jun 2015 12:27:55 +0200
Subject: [PATCH 036/109] Add command line option for generating hyperlinked
 source.

---
 haddock-api/src/Haddock/Options.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
index e847333eda..c9d5688c30 100644
--- a/haddock-api/src/Haddock/Options.hs
+++ b/haddock-api/src/Haddock/Options.hs
@@ -66,6 +66,7 @@ data Flag
   | Flag_WikiEntityURL String
   | Flag_LaTeX
   | Flag_LaTeXStyle String
+  | Flag_HyperlinkedSource
   | Flag_Help
   | Flag_Verbosity String
   | Flag_Version
@@ -116,6 +117,8 @@ options backwardsCompat =
     Option ['U'] ["use-unicode"] (NoArg Flag_UseUnicode) "use Unicode in HTML output",
     Option []  ["hoogle"]     (NoArg Flag_Hoogle)
       "output for Hoogle; you may want --package-name and --package-version too",
+    Option [] ["hyperlinked-source"] (NoArg Flag_HyperlinkedSource)
+      "generate highlighted and hyperlinked source code (for use with --html)",
     Option []  ["source-base"]   (ReqArg Flag_SourceBaseURL "URL")
       "URL for a source code link on the contents\nand index pages",
     Option ['s'] (if backwardsCompat then ["source", "source-module"] else ["source-module"])

From 3eb96a6bbc1f61b81c20df882e243c4d9f4a9404 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 22 Jun 2015 12:51:49 +0200
Subject: [PATCH 037/109] Extend module interface with rich source token stream
 field.

---
 haddock-api/src/Haddock/Interface/Create.hs | 1 +
 haddock-api/src/Haddock/Types.hs            | 5 +++++
 2 files changed, 6 insertions(+)

diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 7491a01e94..63d4436676 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -145,6 +145,7 @@ createInterface tm flags modMap instIfaceMap = do
   , ifaceFamInstances    = fam_instances
   , ifaceHaddockCoverage = coverage
   , ifaceWarningMap      = warningMap
+  , ifaceTokenizedSrc    = Nothing
   }
 
 mkAliasMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 14995098d0..fbb5f44c42 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -35,6 +35,7 @@ import DynFlags (ExtensionFlag, Language)
 import OccName
 import Outputable
 import Control.Monad (ap)
+import Haddock.Backends.Hyperlinker.Ast
 
 -----------------------------------------------------------------------------
 -- * Convenient synonyms
@@ -125,6 +126,10 @@ data Interface = Interface
 
     -- | Warnings for things defined in this module.
   , ifaceWarningMap :: !WarningMap
+
+    -- | Tokenized source code of module (avaliable if Haddock is invoked with
+    -- source generation flag).
+  , ifaceTokenizedSrc :: !(Maybe [RichToken])
   }
 
 type WarningMap = Map Name (Doc Name)

From 4190a05c4abc710d253212017fb4a654ebde1862 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 22 Jun 2015 14:04:41 +0200
Subject: [PATCH 038/109] Implement source tokenization during interface
 creation process.

---
 haddock-api/src/Haddock/Interface/Create.hs | 30 ++++++++++++++++++++-
 1 file changed, 29 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 63d4436676..59f7076fcf 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -21,6 +21,8 @@ import Haddock.GhcUtils
 import Haddock.Utils
 import Haddock.Convert
 import Haddock.Interface.LexParseRn
+import Haddock.Backends.Hyperlinker.Ast as Hyperlinker
+import Haddock.Backends.Hyperlinker.Parser as Hyperlinker
 
 import qualified Data.Map as M
 import Data.Map (Map)
@@ -122,6 +124,8 @@ createInterface tm flags modMap instIfaceMap = do
         mkAliasMap dflags $ tm_renamed_source tm
       modWarn = moduleWarning dflags gre warnings
 
+  tokenizedSrc <- mkMaybeTokenizedSrc flags tm
+
   return $! Interface {
     ifaceMod             = mdl
   , ifaceOrigFilename    = msHsFilePath ms
@@ -145,7 +149,7 @@ createInterface tm flags modMap instIfaceMap = do
   , ifaceFamInstances    = fam_instances
   , ifaceHaddockCoverage = coverage
   , ifaceWarningMap      = warningMap
-  , ifaceTokenizedSrc    = Nothing
+  , ifaceTokenizedSrc    = tokenizedSrc
   }
 
 mkAliasMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName
@@ -862,6 +866,30 @@ seqList :: [a] -> ()
 seqList [] = ()
 seqList (x : xs) = x `seq` seqList xs
 
+mkMaybeTokenizedSrc :: [Flag] -> TypecheckedModule
+                    -> ErrMsgGhc (Maybe [RichToken])
+mkMaybeTokenizedSrc flags tm
+    | Flag_HyperlinkedSource `elem` flags = case renamedSource tm of
+        Just src -> do
+            tokens <- liftGhcToErrMsgGhc . liftIO $ mkTokenizedSrc summary src
+            return $ Just tokens
+        Nothing -> do
+            liftErrMsg . tell . pure $ concat
+                [ "Warning: Cannot hyperlink module \""
+                , moduleNameString . ms_mod_name $ summary
+                , "\" because renamed source is not available"
+                ]
+            return Nothing
+    | otherwise = return Nothing
+  where
+    summary = pm_mod_summary . tm_parsed_module $ tm
+
+mkTokenizedSrc :: ModSummary -> RenamedSource -> IO [RichToken]
+mkTokenizedSrc ms src =
+    Hyperlinker.enrich src . Hyperlinker.parse <$> rawSrc
+  where
+    rawSrc = readFile $ msHsFilePath ms
+
 -- | Find a stand-alone documentation comment by its name.
 findNamedDoc :: String -> [HsDecl Name] -> ErrMsgM (Maybe HsDocString)
 findNamedDoc name = search

From 62d44cd1d37d83fa93d169c2e5b5b758fcc231d6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 22 Jun 2015 16:09:54 +0200
Subject: [PATCH 039/109] Create hyperlinker module and plug it into the
 Haddock pipeline.

---
 haddock-api/haddock-api.cabal                 |  1 +
 haddock-api/src/Haddock.hs                    |  4 +++
 .../src/Haddock/Backends/Hyperlinker.hs       | 25 +++++++++++++++++++
 haddock.cabal                                 |  1 +
 4 files changed, 31 insertions(+)
 create mode 100644 haddock-api/src/Haddock/Backends/Hyperlinker.hs

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 109e5f9555..6ffde976c8 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -82,6 +82,7 @@ library
     Haddock.Backends.LaTeX
     Haddock.Backends.HaddockDB
     Haddock.Backends.Hoogle
+    Haddock.Backends.Hyperlinker
     Haddock.ModuleTree
     Haddock.Types
     Haddock.Doc
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 3e58aba386..e45456abf1 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -30,6 +30,7 @@ import Haddock.Backends.Xhtml
 import Haddock.Backends.Xhtml.Themes (getThemes)
 import Haddock.Backends.LaTeX
 import Haddock.Backends.Hoogle
+import Haddock.Backends.Hyperlinker
 import Haddock.Interface
 import Haddock.Parser
 import Haddock.Types
@@ -308,6 +309,9 @@ render dflags flags qual ifaces installedIfaces srcMap = do
     ppLaTeX title pkgStr visibleIfaces odir (fmap _doc prologue) opt_latex_style
                   libDir
 
+  when (Flag_HyperlinkedSource `elem` flags) $ do
+    ppHyperlinkedSource odir libDir Nothing visibleIfaces
+
 -- | From GHC 7.10, this function has a potential to crash with a
 -- nasty message such as @expectJust getPackageDetails@ because
 -- package name and versions can no longer reliably be extracted in
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
new file mode 100644
index 0000000000..88619474c1
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -0,0 +1,25 @@
+module Haddock.Backends.Hyperlinker (ppHyperlinkedSource) where
+
+import Haddock.Types
+import Haddock.Backends.Hyperlinker.Renderer
+
+import GHC
+import Text.XHtml hiding ((</>))
+import System.Directory
+import System.FilePath
+
+ppHyperlinkedSource :: FilePath -> FilePath -> Maybe FilePath -> [Interface]
+                    -> IO ()
+ppHyperlinkedSource outdir libdir mstyle ifaces = do
+    createDirectoryIfMissing True (outdir </> "src")
+    mapM_ (ppHyperlinkedModuleSource outdir mstyle) ifaces
+
+ppHyperlinkedModuleSource :: FilePath -> Maybe FilePath -> Interface -> IO ()
+ppHyperlinkedModuleSource outdir mstyle iface = case ifaceTokenizedSrc iface of
+    Just tokens -> writeFile path $ showHtml . render mstyle $ tokens
+    Nothing -> return ()
+  where
+    path = outdir </> "src" </> moduleSourceFile (ifaceMod iface)
+
+moduleSourceFile :: Module -> FilePath
+moduleSourceFile = (++ ".html") . moduleNameString . moduleName
diff --git a/haddock.cabal b/haddock.cabal
index ed570f5368..0aebefd8f5 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -101,6 +101,7 @@ executable haddock
       Haddock.Backends.LaTeX
       Haddock.Backends.HaddockDB
       Haddock.Backends.Hoogle
+      Haddock.Backends.Hyperlinker
       Haddock.ModuleTree
       Haddock.Types
       Haddock.Doc

From 6f16398a26a12d58b3ba7f1924e2b6b00e68f5f7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 22 Jun 2015 17:20:37 +0200
Subject: [PATCH 040/109] Add support for providing custom CSS files for
 hyperlinked source.

---
 haddock-api/haddock-api.cabal                 |  1 +
 haddock-api/resources/html/solarized.css      | 55 +++++++++++++++++++
 haddock-api/src/Haddock.hs                    |  3 +-
 .../src/Haddock/Backends/Hyperlinker.hs       | 26 +++++++--
 haddock-api/src/Haddock/Options.hs            |  6 ++
 5 files changed, 84 insertions(+), 7 deletions(-)
 create mode 100644 haddock-api/resources/html/solarized.css

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 6ffde976c8..1465699467 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -18,6 +18,7 @@ stability:            experimental
 data-dir:
   resources
 data-files:
+  html/solarized.css
   html/frames.html
   html/haddock-util.js
   html/Classic.theme/haskell_icon.gif
diff --git a/haddock-api/resources/html/solarized.css b/haddock-api/resources/html/solarized.css
new file mode 100644
index 0000000000..e4bff385d4
--- /dev/null
+++ b/haddock-api/resources/html/solarized.css
@@ -0,0 +1,55 @@
+body {
+	background-color: #fdf6e3;
+}
+
+.hs-identifier {
+	color: #073642;
+}
+
+.hs-identifier.hs-var {
+}
+
+.hs-identifier.hs-type {
+	color: #5f5faf;
+}
+
+.hs-keyword {
+	color: #af005f;
+}
+
+.hs-string, .hs-char {
+	color: #cb4b16;
+}
+
+.hs-number {
+	color: #268bd2;
+}
+
+.hs-operator {
+	color: #d33682;
+}
+
+.hs-glyph, .hs-special {
+	color: #dc322f;
+}
+
+.hs-comment {
+	color: #8a8a8a;
+}
+
+.hs-pragma {
+	color: #2aa198;
+}
+
+.hs-cpp {
+	color: #859900;
+}
+
+a:link, a:visited {
+	text-decoration: none;
+	border-bottom: 1px solid #eee8d5;
+}
+
+a:hover {
+	background-color: #eee8d5;
+}
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index e45456abf1..698122e367 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -244,6 +244,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do
     opt_index_url        = optIndexUrl       flags
     odir                 = outputDir         flags
     opt_latex_style      = optLaTeXStyle     flags
+    opt_source_css       = optSourceCssFile  flags
 
     visibleIfaces    = [ i | i <- ifaces, OptHide `notElem` ifaceOptions i ]
 
@@ -310,7 +311,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do
                   libDir
 
   when (Flag_HyperlinkedSource `elem` flags) $ do
-    ppHyperlinkedSource odir libDir Nothing visibleIfaces
+    ppHyperlinkedSource odir libDir opt_source_css visibleIfaces
 
 -- | From GHC 7.10, this function has a potential to crash with a
 -- nasty message such as @expectJust getPackageDetails@ because
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 88619474c1..66392a67a0 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -5,21 +5,35 @@ import Haddock.Backends.Hyperlinker.Renderer
 
 import GHC
 import Text.XHtml hiding ((</>))
+
+import Data.Maybe
 import System.Directory
 import System.FilePath
 
 ppHyperlinkedSource :: FilePath -> FilePath -> Maybe FilePath -> [Interface]
                     -> IO ()
 ppHyperlinkedSource outdir libdir mstyle ifaces = do
-    createDirectoryIfMissing True (outdir </> "src")
-    mapM_ (ppHyperlinkedModuleSource outdir mstyle) ifaces
+    createDirectoryIfMissing True $ srcPath outdir
+    let cssFile = fromMaybe (defaultCssFile libdir) mstyle
+    copyFile cssFile $ srcPath outdir </> srcCssFile
+    mapM_ (ppHyperlinkedModuleSource outdir) ifaces
 
-ppHyperlinkedModuleSource :: FilePath -> Maybe FilePath -> Interface -> IO ()
-ppHyperlinkedModuleSource outdir mstyle iface = case ifaceTokenizedSrc iface of
-    Just tokens -> writeFile path $ showHtml . render mstyle $ tokens
+ppHyperlinkedModuleSource :: FilePath -> Interface -> IO ()
+ppHyperlinkedModuleSource outdir iface = case ifaceTokenizedSrc iface of
+    Just tokens -> writeFile path $ showHtml . render mSrcCssFile $ tokens
     Nothing -> return ()
   where
-    path = outdir </> "src" </> moduleSourceFile (ifaceMod iface)
+    mSrcCssFile = Just $ srcCssFile
+    path = srcPath outdir </> moduleSourceFile (ifaceMod iface)
 
 moduleSourceFile :: Module -> FilePath
 moduleSourceFile = (++ ".html") . moduleNameString . moduleName
+
+srcPath :: FilePath -> FilePath
+srcPath outdir = outdir </> "src"
+
+srcCssFile :: FilePath
+srcCssFile = "style.css"
+
+defaultCssFile :: FilePath -> FilePath
+defaultCssFile libdir = libdir </> "html" </> "solarized.css"
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
index c9d5688c30..f84989efde 100644
--- a/haddock-api/src/Haddock/Options.hs
+++ b/haddock-api/src/Haddock/Options.hs
@@ -21,6 +21,7 @@ module Haddock.Options (
   optContentsUrl,
   optIndexUrl,
   optCssFile,
+  optSourceCssFile,
   sourceUrls,
   wikiUrls,
   optDumpInterfaceFile,
@@ -67,6 +68,7 @@ data Flag
   | Flag_LaTeX
   | Flag_LaTeXStyle String
   | Flag_HyperlinkedSource
+  | Flag_SourceCss String
   | Flag_Help
   | Flag_Verbosity String
   | Flag_Version
@@ -119,6 +121,8 @@ options backwardsCompat =
       "output for Hoogle; you may want --package-name and --package-version too",
     Option [] ["hyperlinked-source"] (NoArg Flag_HyperlinkedSource)
       "generate highlighted and hyperlinked source code (for use with --html)",
+    Option [] ["source-css"] (ReqArg Flag_SourceCss "FILE")
+      "use custom CSS file instead of default one in hyperlinked source",
     Option []  ["source-base"]   (ReqArg Flag_SourceBaseURL "URL")
       "URL for a source code link on the contents\nand index pages",
     Option ['s'] (if backwardsCompat then ["source", "source-module"] else ["source-module"])
@@ -242,6 +246,8 @@ optIndexUrl flags = optLast [ url | Flag_UseIndex url <- flags ]
 optCssFile :: [Flag] -> Maybe FilePath
 optCssFile flags = optLast [ str | Flag_CSS str <- flags ]
 
+optSourceCssFile :: [Flag] -> Maybe FilePath
+optSourceCssFile flags = optLast [ str | Flag_SourceCss str <- flags ]
 
 sourceUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String, Maybe String)
 sourceUrls flags =

From a6bd86a8550d5d7e8bdb12e1d09036b9f88eed73 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 22 Jun 2015 17:41:31 +0200
Subject: [PATCH 041/109] Add support for fancy highlighting upon hovering over
 identifier.

---
 haddock-api/haddock-api.cabal                 |  1 +
 haddock-api/resources/html/highlight.js       | 46 +++++++++++++++++++
 .../src/Haddock/Backends/Hyperlinker.hs       | 10 +++-
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 23 ++++++----
 4 files changed, 70 insertions(+), 10 deletions(-)
 create mode 100644 haddock-api/resources/html/highlight.js

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 1465699467..216627cc84 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -21,6 +21,7 @@ data-files:
   html/solarized.css
   html/frames.html
   html/haddock-util.js
+  html/highlight.js
   html/Classic.theme/haskell_icon.gif
   html/Classic.theme/minus.gif
   html/Classic.theme/plus.gif
diff --git a/haddock-api/resources/html/highlight.js b/haddock-api/resources/html/highlight.js
new file mode 100644
index 0000000000..639cf5d57a
--- /dev/null
+++ b/haddock-api/resources/html/highlight.js
@@ -0,0 +1,46 @@
+
+var styleForRule = function (rule) {
+	var sheets = document.styleSheets;
+	for (var s = 0; s < sheets.length; s++) {
+		var rules = sheets[s].cssRules;
+		for (var r = 0; r < rules.length; r++) {
+			if (rules[r].selectorText == rule) {
+				return rules[r].style;
+			}
+		}
+	}
+};
+
+var highlight = function () {
+	var color = styleForRule("a:hover")["background-color"];
+	var links = document.getElementsByTagName('a');
+	for (var i = 0; i < links.length; i++) {
+		var that = links[i];
+		if (this.href == that.href) {
+			that.style["background-color"] = color;
+		}
+	}
+};
+
+/*
+ * I have no idea what is the proper antonym for "highlight" in this
+ * context. "Diminish"? "Unhighlight"? "Lowlight" sounds ridiculously
+ * so I like it.
+ */
+var lowlight = function () {
+	var links = document.getElementsByTagName('a');
+	for (var i = 0; i < links.length; i++) {
+		var that = links[i];
+		if (this.href == that.href) {
+			that.style["background-color"] = "";
+		}
+	}
+};
+
+window.onload = function () {
+	var links = document.getElementsByTagName('a');
+	for (var i = 0; i < links.length; i++) {
+		links[i].onmouseover = highlight;
+		links[i].onmouseout = lowlight;
+	}
+};
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 66392a67a0..9337307cee 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -16,14 +16,17 @@ ppHyperlinkedSource outdir libdir mstyle ifaces = do
     createDirectoryIfMissing True $ srcPath outdir
     let cssFile = fromMaybe (defaultCssFile libdir) mstyle
     copyFile cssFile $ srcPath outdir </> srcCssFile
+    copyFile (libdir </> "html" </> highlightScript) $
+        srcPath outdir </> highlightScript
     mapM_ (ppHyperlinkedModuleSource outdir) ifaces
 
 ppHyperlinkedModuleSource :: FilePath -> Interface -> IO ()
 ppHyperlinkedModuleSource outdir iface = case ifaceTokenizedSrc iface of
-    Just tokens -> writeFile path $ showHtml . render mSrcCssFile $ tokens
+    Just tokens -> writeFile path $ showHtml . render mCssFile mJsFile $ tokens
     Nothing -> return ()
   where
-    mSrcCssFile = Just $ srcCssFile
+    mCssFile = Just $ srcCssFile
+    mJsFile = Just $ highlightScript
     path = srcPath outdir </> moduleSourceFile (ifaceMod iface)
 
 moduleSourceFile :: Module -> FilePath
@@ -35,5 +38,8 @@ srcPath outdir = outdir </> "src"
 srcCssFile :: FilePath
 srcCssFile = "style.css"
 
+highlightScript :: FilePath
+highlightScript = "highlight.js"
+
 defaultCssFile :: FilePath -> FilePath
 defaultCssFile libdir = libdir </> "html" </> "solarized.css"
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 7052475903..6d6d2012ae 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -16,21 +16,28 @@ import qualified Text.XHtml as Html
 
 type StyleClass = String
 
-render :: Maybe FilePath -> [RichToken] -> Html
-render css tokens = header css <> body tokens
+render :: Maybe FilePath -> Maybe FilePath -> [RichToken] -> Html
+render mcss mjs tokens = header mcss mjs <> body tokens
 
 body :: [RichToken] -> Html
 body = Html.body . Html.pre . mconcat . map richToken
 
-header :: Maybe FilePath -> Html
-header Nothing = Html.noHtml
-header (Just css) =
-    Html.header $ Html.thelink Html.noHtml ! attrs
+header :: Maybe FilePath -> Maybe FilePath -> Html
+header mcss mjs
+    | isNothing mcss && isNothing mjs = Html.noHtml
+header mcss mjs =
+    Html.header $ css mcss <> js mjs
   where
-    attrs =
+    css Nothing = Html.noHtml
+    css (Just cssFile) = Html.thelink Html.noHtml !
         [ Html.rel "stylesheet"
-        , Html.href css
         , Html.thetype "text/css"
+        , Html.href cssFile
+        ]
+    js Nothing = Html.noHtml
+    js (Just jsFile) = Html.script Html.noHtml !
+        [ Html.thetype "text/javascript"
+        , Html.src jsFile
         ]
 
 richToken :: RichToken -> Html

From affd889d1b192d2cb9787c92202317b9e9401922 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 26 Jun 2015 21:13:12 +0200
Subject: [PATCH 042/109] Make source hyperlinker generate output in apropriate
 directory.

---
 haddock-api/src/Haddock.hs                    | 10 ++++-
 .../src/Haddock/Backends/Hyperlinker.hs       | 41 +++++++++++--------
 haddock-api/src/Haddock/Utils.hs              |  5 +++
 3 files changed, 38 insertions(+), 18 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 698122e367..01e4cd4541 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -258,10 +258,16 @@ render dflags flags qual ifaces installedIfaces srcMap = do
     pkgNameVer       = modulePackageInfo dflags flags pkgMod
 
     (srcBase, srcModule, srcEntity, srcLEntity) = sourceUrls flags
+
+    srcModule'
+      | isJust srcModule = srcModule
+      | Flag_HyperlinkedSource `elem` flags = Just defaultModuleSourceUrl
+      | otherwise = Nothing
+
     srcMap' = maybe srcMap (\path -> Map.insert pkgKey path srcMap) srcEntity
     -- TODO: Get these from the interface files as with srcMap
     srcLMap' = maybe Map.empty (\path -> Map.singleton pkgKey path) srcLEntity
-    sourceUrls' = (srcBase, srcModule, srcMap', srcLMap')
+    sourceUrls' = (srcBase, srcModule', srcMap', srcLMap')
 
   libDir   <- getHaddockLibDir flags
   prologue <- getPrologue dflags flags
@@ -311,7 +317,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do
                   libDir
 
   when (Flag_HyperlinkedSource `elem` flags) $ do
-    ppHyperlinkedSource odir libDir opt_source_css visibleIfaces
+    ppHyperlinkedSource odir libDir opt_source_css sourceUrls' visibleIfaces
 
 -- | From GHC 7.10, this function has a potential to crash with a
 -- nasty message such as @expectJust getPackageDetails@ because
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 9337307cee..2ed4dbdd25 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -1,45 +1,54 @@
 module Haddock.Backends.Hyperlinker (ppHyperlinkedSource) where
 
 import Haddock.Types
+import Haddock.Utils
+import Haddock.Backends.Xhtml.Types
+import Haddock.Backends.Xhtml.Utils
 import Haddock.Backends.Hyperlinker.Renderer
 
-import GHC
 import Text.XHtml hiding ((</>))
 
 import Data.Maybe
 import System.Directory
 import System.FilePath
 
-ppHyperlinkedSource :: FilePath -> FilePath -> Maybe FilePath -> [Interface]
+ppHyperlinkedSource :: FilePath -> FilePath
+                    -> Maybe FilePath
+                    -> SourceURLs
+                    -> [Interface]
                     -> IO ()
-ppHyperlinkedSource outdir libdir mstyle ifaces = do
-    createDirectoryIfMissing True $ srcPath outdir
+ppHyperlinkedSource outdir libdir mstyle urls ifaces = do
+    createDirectoryIfMissing True srcdir
     let cssFile = fromMaybe (defaultCssFile libdir) mstyle
-    copyFile cssFile $ srcPath outdir </> srcCssFile
+    copyFile cssFile $ srcdir </> srcCssFile
     copyFile (libdir </> "html" </> highlightScript) $
-        srcPath outdir </> highlightScript
-    mapM_ (ppHyperlinkedModuleSource outdir) ifaces
+        srcdir </> highlightScript
+    mapM_ (ppHyperlinkedModuleSource outdir urls) ifaces
+  where
+    srcdir = srcPath outdir urls
 
-ppHyperlinkedModuleSource :: FilePath -> Interface -> IO ()
-ppHyperlinkedModuleSource outdir iface = case ifaceTokenizedSrc iface of
+ppHyperlinkedModuleSource :: FilePath -> SourceURLs -> Interface -> IO ()
+ppHyperlinkedModuleSource outdir urls iface = case ifaceTokenizedSrc iface of
     Just tokens -> writeFile path $ showHtml . render mCssFile mJsFile $ tokens
     Nothing -> return ()
   where
     mCssFile = Just $ srcCssFile
     mJsFile = Just $ highlightScript
-    path = srcPath outdir </> moduleSourceFile (ifaceMod iface)
-
-moduleSourceFile :: Module -> FilePath
-moduleSourceFile = (++ ".html") . moduleNameString . moduleName
+    srcFile = spliceURL Nothing (Just $ ifaceMod iface) Nothing Nothing $
+        srcModUrl urls
+    path = outdir </> srcFile
 
-srcPath :: FilePath -> FilePath
-srcPath outdir = outdir </> "src"
+srcPath :: FilePath -> SourceURLs -> FilePath
+srcPath outdir urls = outdir </> takeDirectory (srcModUrl urls)
 
 srcCssFile :: FilePath
-srcCssFile = "style.css"
+srcCssFile = "srcstyle.css"
 
 highlightScript :: FilePath
 highlightScript = "highlight.js"
 
 defaultCssFile :: FilePath -> FilePath
 defaultCssFile libdir = libdir </> "html" </> "solarized.css"
+
+srcModUrl :: SourceURLs -> String
+srcModUrl (_, mModSrcUrl, _, _) = fromMaybe defaultModuleSourceUrl mModSrcUrl
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 4fed3a1ee7..78c78aca09 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -29,6 +29,7 @@ module Haddock.Utils (
   moduleNameUrl, moduleNameUrl', moduleUrl,
   nameAnchorId,
   makeAnchorId,
+  defaultModuleSourceUrl,
 
   -- * Miscellaneous utilities
   getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr,
@@ -277,6 +278,10 @@ makeAnchorId (f:r) = escape isAlpha f ++ concatMap (escape isLegal) r
        -- NB: '-' is legal in IDs, but we use it as the escape char
 
 
+defaultModuleSourceUrl :: String
+defaultModuleSourceUrl = "src/%{MODULE}.html"
+
+
 -------------------------------------------------------------------------------
 -- * Files we need to copy from our $libdir
 -------------------------------------------------------------------------------

From 844c09d0c1d724e0f0f0698654f2f85f5f58be19 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 26 Jun 2015 22:24:57 +0200
Subject: [PATCH 043/109] Create module with hyperlinker utility functions.

---
 haddock-api/haddock-api.cabal                  |  1 +
 .../src/Haddock/Backends/Hyperlinker/Utils.hs  | 18 ++++++++++++++++++
 2 files changed, 19 insertions(+)
 create mode 100644 haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 216627cc84..7670f888cb 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -85,6 +85,7 @@ library
     Haddock.Backends.HaddockDB
     Haddock.Backends.Hoogle
     Haddock.Backends.Hyperlinker
+    Haddock.Backends.Hyperlinker.Utils
     Haddock.ModuleTree
     Haddock.Types
     Haddock.Doc
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
new file mode 100644
index 0000000000..25ed942b43
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
@@ -0,0 +1,18 @@
+module Haddock.Backends.Hyperlinker.Utils
+    ( srcModUrl
+    , srcNameUrlMap
+    ) where
+
+import Haddock.Utils
+import Haddock.Backends.Xhtml.Types
+
+import GHC
+
+import Data.Maybe
+import Data.Map (Map)
+
+srcModUrl :: SourceURLs -> String
+srcModUrl (_, mModUrl, _, _) = fromMaybe defaultModuleSourceUrl mModUrl
+
+srcNameUrlMap :: SourceURLs -> Map PackageKey FilePath
+srcNameUrlMap (_, _, nameUrlMap, _) = nameUrlMap

From d58bcf24dfa4333e7893935eb86c036be28125b1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Fri, 26 Jun 2015 22:41:07 +0200
Subject: [PATCH 044/109] Make external hyperlinks point to locations specified
 by source URLs.

---
 haddock-api/src/Haddock.hs                    |  7 ++-
 .../src/Haddock/Backends/Hyperlinker.hs       |  8 ++-
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 52 +++++++++++--------
 haddock-api/src/Haddock/Utils.hs              |  5 +-
 4 files changed, 44 insertions(+), 28 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 01e4cd4541..3105edf598 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -264,7 +264,12 @@ render dflags flags qual ifaces installedIfaces srcMap = do
       | Flag_HyperlinkedSource `elem` flags = Just defaultModuleSourceUrl
       | otherwise = Nothing
 
-    srcMap' = maybe srcMap (\path -> Map.insert pkgKey path srcMap) srcEntity
+    srcMap'
+      | Just srcNameUrl <- srcEntity = Map.insert pkgKey srcNameUrl srcMap
+      | Flag_HyperlinkedSource `elem` flags =
+          Map.insert pkgKey defaultNameSourceUrl srcMap
+      | otherwise = srcMap
+
     -- TODO: Get these from the interface files as with srcMap
     srcLMap' = maybe Map.empty (\path -> Map.singleton pkgKey path) srcLEntity
     sourceUrls' = (srcBase, srcModule', srcMap', srcLMap')
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 2ed4dbdd25..6c66e0c6b3 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -1,10 +1,10 @@
 module Haddock.Backends.Hyperlinker (ppHyperlinkedSource) where
 
 import Haddock.Types
-import Haddock.Utils
 import Haddock.Backends.Xhtml.Types
 import Haddock.Backends.Xhtml.Utils
 import Haddock.Backends.Hyperlinker.Renderer
+import Haddock.Backends.Hyperlinker.Utils
 
 import Text.XHtml hiding ((</>))
 
@@ -29,7 +29,8 @@ ppHyperlinkedSource outdir libdir mstyle urls ifaces = do
 
 ppHyperlinkedModuleSource :: FilePath -> SourceURLs -> Interface -> IO ()
 ppHyperlinkedModuleSource outdir urls iface = case ifaceTokenizedSrc iface of
-    Just tokens -> writeFile path $ showHtml . render mCssFile mJsFile $ tokens
+    Just tokens ->
+        writeFile path $ showHtml . render mCssFile mJsFile urls $ tokens
     Nothing -> return ()
   where
     mCssFile = Just $ srcCssFile
@@ -49,6 +50,3 @@ highlightScript = "highlight.js"
 
 defaultCssFile :: FilePath -> FilePath
 defaultCssFile libdir = libdir </> "html" </> "solarized.css"
-
-srcModUrl :: SourceURLs -> String
-srcModUrl (_, mModSrcUrl, _, _) = fromMaybe defaultModuleSourceUrl mModSrcUrl
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 6d6d2012ae..2df6293806 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -2,12 +2,16 @@ module Haddock.Backends.Hyperlinker.Renderer (render) where
 
 import Haddock.Backends.Hyperlinker.Parser
 import Haddock.Backends.Hyperlinker.Ast
+import Haddock.Backends.Hyperlinker.Utils
+import Haddock.Backends.Xhtml.Types
+import Haddock.Backends.Xhtml.Utils
 
 import qualified GHC
 import qualified Name as GHC
 import qualified Unique as GHC
 
 import Data.List
+import qualified Data.Map as Map
 import Data.Maybe
 import Data.Monoid
 
@@ -16,11 +20,11 @@ import qualified Text.XHtml as Html
 
 type StyleClass = String
 
-render :: Maybe FilePath -> Maybe FilePath -> [RichToken] -> Html
-render mcss mjs tokens = header mcss mjs <> body tokens
+render :: Maybe FilePath -> Maybe FilePath -> SourceURLs -> [RichToken] -> Html
+render mcss mjs urls tokens = header mcss mjs <> body urls tokens
 
-body :: [RichToken] -> Html
-body = Html.body . Html.pre . mconcat . map richToken
+body :: SourceURLs -> [RichToken] -> Html
+body urls = Html.body . Html.pre . mconcat . map (richToken urls)
 
 header :: Maybe FilePath -> Maybe FilePath -> Html
 header mcss mjs
@@ -40,13 +44,13 @@ header mcss mjs =
         , Html.src jsFile
         ]
 
-richToken :: RichToken -> Html
-richToken (RichToken tok Nothing) =
+richToken :: SourceURLs -> RichToken -> Html
+richToken _ (RichToken tok Nothing) =
     tokenSpan tok ! attrs
   where
     attrs = [ multiclass . tokenStyle . tkType $ tok ]
-richToken (RichToken tok (Just det)) =
-    externalAnchor det . internalAnchor det . hyperlink det $ content
+richToken urls (RichToken tok (Just det)) =
+    externalAnchor det . internalAnchor det . hyperlink urls det $ content
   where
     content = tokenSpan tok ! [ multiclass style]
     style = (tokenStyle . tkType) tok ++ richTokenStyle det
@@ -93,26 +97,32 @@ externalAnchorIdent = GHC.occNameString . GHC.nameOccName
 internalAnchorIdent :: GHC.Name -> String
 internalAnchorIdent = ("local-" ++) . show . GHC.getKey . GHC.nameUnique
 
-hyperlink :: TokenDetails -> Html -> Html
-hyperlink details = case rtkName details of
+hyperlink :: SourceURLs -> TokenDetails -> Html -> Html
+hyperlink urls details = case rtkName details of
     Left name ->
         if GHC.isInternalName name
         then internalHyperlink name
-        else externalHyperlink mname (Just name)
-      where
-        mname = GHC.moduleName <$> GHC.nameModule_maybe name
-    Right name -> externalHyperlink (Just name) Nothing
+        else externalNameHyperlink urls name
+    Right name -> externalModHyperlink name
 
 internalHyperlink :: GHC.Name -> Html -> Html
 internalHyperlink name content =
     Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ]
 
-externalHyperlink :: Maybe GHC.ModuleName -> Maybe GHC.Name -> Html -> Html
-externalHyperlink mmname miname content =
-    Html.anchor content ! [ Html.href $ path ++ anchor ]
+externalNameHyperlink :: SourceURLs -> GHC.Name -> Html -> Html
+externalNameHyperlink urls name =
+    case Map.lookup key $ srcNameUrlMap urls of
+        Just url -> externalNameHyperlink' url name
+        Nothing -> id
   where
-    path = fromMaybe "" $ modulePath <$> mmname
-    anchor = fromMaybe "" $ ("#" ++) . externalAnchorIdent <$> miname
+    key = GHC.modulePackageKey . GHC.nameModule $ name
 
-modulePath :: GHC.ModuleName -> String
-modulePath name = GHC.moduleNameString name ++ ".html"
+externalNameHyperlink' :: String -> GHC.Name -> Html -> Html
+externalNameHyperlink' url name content =
+    Html.anchor content ! [ Html.href $ href ]
+  where
+    mdl = GHC.nameModule name
+    href = spliceURL Nothing (Just mdl) (Just name) Nothing url
+
+externalModHyperlink :: GHC.ModuleName -> Html -> Html
+externalModHyperlink _ = id -- TODO
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 78c78aca09..047d9fd0f2 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -29,7 +29,7 @@ module Haddock.Utils (
   moduleNameUrl, moduleNameUrl', moduleUrl,
   nameAnchorId,
   makeAnchorId,
-  defaultModuleSourceUrl,
+  defaultModuleSourceUrl, defaultNameSourceUrl,
 
   -- * Miscellaneous utilities
   getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr,
@@ -281,6 +281,9 @@ makeAnchorId (f:r) = escape isAlpha f ++ concatMap (escape isLegal) r
 defaultModuleSourceUrl :: String
 defaultModuleSourceUrl = "src/%{MODULE}.html"
 
+defaultNameSourceUrl :: String
+defaultNameSourceUrl = defaultModuleSourceUrl ++ "#%{NAME}"
+
 
 -------------------------------------------------------------------------------
 -- * Files we need to copy from our $libdir

From ab070206d67748232995a262b533957a5a7b9315 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sat, 27 Jun 2015 18:03:56 +0200
Subject: [PATCH 045/109] Rewrite source generation to fixed links and
 directory structure.

---
 haddock-api/src/Haddock.hs                    | 11 ++--
 .../src/Haddock/Backends/Hyperlinker.hs       | 29 +++++------
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 52 ++++++++-----------
 .../src/Haddock/Backends/Hyperlinker/Utils.hs | 48 +++++++++++++----
 .../src/Haddock/Backends/Xhtml/Utils.hs       | 14 +++--
 haddock-api/src/Haddock/Utils.hs              |  8 ---
 6 files changed, 85 insertions(+), 77 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 3105edf598..d596c075f7 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -260,14 +260,13 @@ render dflags flags qual ifaces installedIfaces srcMap = do
     (srcBase, srcModule, srcEntity, srcLEntity) = sourceUrls flags
 
     srcModule'
-      | isJust srcModule = srcModule
-      | Flag_HyperlinkedSource `elem` flags = Just defaultModuleSourceUrl
-      | otherwise = Nothing
+      | Flag_HyperlinkedSource `elem` flags = Just hypSrcModuleUrlFormat
+      | otherwise = srcModule
 
     srcMap'
-      | Just srcNameUrl <- srcEntity = Map.insert pkgKey srcNameUrl srcMap
       | Flag_HyperlinkedSource `elem` flags =
-          Map.insert pkgKey defaultNameSourceUrl srcMap
+          Map.insert pkgKey hypSrcModuleNameUrlFormat srcMap
+      | Just srcNameUrl <- srcEntity = Map.insert pkgKey srcNameUrl srcMap
       | otherwise = srcMap
 
     -- TODO: Get these from the interface files as with srcMap
@@ -322,7 +321,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do
                   libDir
 
   when (Flag_HyperlinkedSource `elem` flags) $ do
-    ppHyperlinkedSource odir libDir opt_source_css sourceUrls' visibleIfaces
+    ppHyperlinkedSource odir libDir opt_source_css visibleIfaces
 
 -- | From GHC 7.10, this function has a potential to crash with a
 -- nasty message such as @expectJust getPackageDetails@ because
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 6c66e0c6b3..f197eaa3d6 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -1,8 +1,9 @@
-module Haddock.Backends.Hyperlinker (ppHyperlinkedSource) where
+module Haddock.Backends.Hyperlinker
+    ( ppHyperlinkedSource
+    , module Haddock.Backends.Hyperlinker.Utils
+    ) where
 
 import Haddock.Types
-import Haddock.Backends.Xhtml.Types
-import Haddock.Backends.Xhtml.Utils
 import Haddock.Backends.Hyperlinker.Renderer
 import Haddock.Backends.Hyperlinker.Utils
 
@@ -14,36 +15,30 @@ import System.FilePath
 
 ppHyperlinkedSource :: FilePath -> FilePath
                     -> Maybe FilePath
-                    -> SourceURLs
                     -> [Interface]
                     -> IO ()
-ppHyperlinkedSource outdir libdir mstyle urls ifaces = do
+ppHyperlinkedSource outdir libdir mstyle ifaces = do
     createDirectoryIfMissing True srcdir
     let cssFile = fromMaybe (defaultCssFile libdir) mstyle
     copyFile cssFile $ srcdir </> srcCssFile
     copyFile (libdir </> "html" </> highlightScript) $
         srcdir </> highlightScript
-    mapM_ (ppHyperlinkedModuleSource outdir urls) ifaces
+    mapM_ (ppHyperlinkedModuleSource srcdir) ifaces
   where
-    srcdir = srcPath outdir urls
+    srcdir = outdir </> hypSrcDir
 
-ppHyperlinkedModuleSource :: FilePath -> SourceURLs -> Interface -> IO ()
-ppHyperlinkedModuleSource outdir urls iface = case ifaceTokenizedSrc iface of
+ppHyperlinkedModuleSource :: FilePath -> Interface -> IO ()
+ppHyperlinkedModuleSource srcdir iface = case ifaceTokenizedSrc iface of
     Just tokens ->
-        writeFile path $ showHtml . render mCssFile mJsFile urls $ tokens
+        writeFile path $ showHtml . render mCssFile mJsFile $ tokens
     Nothing -> return ()
   where
     mCssFile = Just $ srcCssFile
     mJsFile = Just $ highlightScript
-    srcFile = spliceURL Nothing (Just $ ifaceMod iface) Nothing Nothing $
-        srcModUrl urls
-    path = outdir </> srcFile
-
-srcPath :: FilePath -> SourceURLs -> FilePath
-srcPath outdir urls = outdir </> takeDirectory (srcModUrl urls)
+    path = srcdir </> hypSrcModuleFile (ifaceMod iface)
 
 srcCssFile :: FilePath
-srcCssFile = "srcstyle.css"
+srcCssFile = "style.css"
 
 highlightScript :: FilePath
 highlightScript = "highlight.js"
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 2df6293806..d8ea5ec71e 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -3,15 +3,12 @@ module Haddock.Backends.Hyperlinker.Renderer (render) where
 import Haddock.Backends.Hyperlinker.Parser
 import Haddock.Backends.Hyperlinker.Ast
 import Haddock.Backends.Hyperlinker.Utils
-import Haddock.Backends.Xhtml.Types
-import Haddock.Backends.Xhtml.Utils
 
 import qualified GHC
 import qualified Name as GHC
 import qualified Unique as GHC
 
 import Data.List
-import qualified Data.Map as Map
 import Data.Maybe
 import Data.Monoid
 
@@ -20,11 +17,11 @@ import qualified Text.XHtml as Html
 
 type StyleClass = String
 
-render :: Maybe FilePath -> Maybe FilePath -> SourceURLs -> [RichToken] -> Html
-render mcss mjs urls tokens = header mcss mjs <> body urls tokens
+render :: Maybe FilePath -> Maybe FilePath -> [RichToken] -> Html
+render mcss mjs tokens = header mcss mjs <> body tokens
 
-body :: SourceURLs -> [RichToken] -> Html
-body urls = Html.body . Html.pre . mconcat . map (richToken urls)
+body :: [RichToken] -> Html
+body = Html.body . Html.pre . mconcat . map richToken
 
 header :: Maybe FilePath -> Maybe FilePath -> Html
 header mcss mjs
@@ -39,18 +36,18 @@ header mcss mjs =
         , Html.href cssFile
         ]
     js Nothing = Html.noHtml
-    js (Just jsFile) = Html.script Html.noHtml !
+    js (Just scriptFile) = Html.script Html.noHtml !
         [ Html.thetype "text/javascript"
-        , Html.src jsFile
+        , Html.src scriptFile
         ]
 
-richToken :: SourceURLs -> RichToken -> Html
-richToken _ (RichToken tok Nothing) =
+richToken :: RichToken -> Html
+richToken (RichToken tok Nothing) =
     tokenSpan tok ! attrs
   where
     attrs = [ multiclass . tokenStyle . tkType $ tok ]
-richToken urls (RichToken tok (Just det)) =
-    externalAnchor det . internalAnchor det . hyperlink urls det $ content
+richToken (RichToken tok (Just det)) =
+    externalAnchor det . internalAnchor det . hyperlink det $ content
   where
     content = tokenSpan tok ! [ multiclass style]
     style = (tokenStyle . tkType) tok ++ richTokenStyle det
@@ -92,37 +89,30 @@ internalAnchor (RtkBind name) content =
 internalAnchor _ content = content
 
 externalAnchorIdent :: GHC.Name -> String
-externalAnchorIdent = GHC.occNameString . GHC.nameOccName
+externalAnchorIdent = hypSrcNameUrl
 
 internalAnchorIdent :: GHC.Name -> String
 internalAnchorIdent = ("local-" ++) . show . GHC.getKey . GHC.nameUnique
 
-hyperlink :: SourceURLs -> TokenDetails -> Html -> Html
-hyperlink urls details = case rtkName details of
+hyperlink :: TokenDetails -> Html -> Html
+hyperlink details = case rtkName details of
     Left name ->
         if GHC.isInternalName name
         then internalHyperlink name
-        else externalNameHyperlink urls name
+        else externalNameHyperlink name
     Right name -> externalModHyperlink name
 
 internalHyperlink :: GHC.Name -> Html -> Html
 internalHyperlink name content =
     Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ]
 
-externalNameHyperlink :: SourceURLs -> GHC.Name -> Html -> Html
-externalNameHyperlink urls name =
-    case Map.lookup key $ srcNameUrlMap urls of
-        Just url -> externalNameHyperlink' url name
-        Nothing -> id
+externalNameHyperlink :: GHC.Name -> Html -> Html
+externalNameHyperlink name content =
+    Html.anchor content ! [ Html.href href ]
   where
-    key = GHC.modulePackageKey . GHC.nameModule $ name
-
-externalNameHyperlink' :: String -> GHC.Name -> Html -> Html
-externalNameHyperlink' url name content =
-    Html.anchor content ! [ Html.href $ href ]
-  where
-    mdl = GHC.nameModule name
-    href = spliceURL Nothing (Just mdl) (Just name) Nothing url
+    href = hypSrcModuleNameUrl (GHC.nameModule name) name
 
 externalModHyperlink :: GHC.ModuleName -> Html -> Html
-externalModHyperlink _ = id -- TODO
+externalModHyperlink mdl content =
+    Html.anchor content ! [ Html.href $ hypSrcModuleUrl' mdl ]
+
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
index 25ed942b43..9ba8446dd8 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
@@ -1,18 +1,46 @@
 module Haddock.Backends.Hyperlinker.Utils
-    ( srcModUrl
-    , srcNameUrlMap
+    ( hypSrcDir, hypSrcModuleFile, hypSrcModuleFile'
+    , hypSrcModuleUrl, hypSrcModuleUrl', hypSrcNameUrl, hypSrcModuleNameUrl
+    , hypSrcModuleUrlFormat, hypSrcModuleNameUrlFormat,
     ) where
 
-import Haddock.Utils
-import Haddock.Backends.Xhtml.Types
+import Haddock.Backends.Xhtml.Utils
 
 import GHC
+import System.FilePath.Posix ((</>))
 
-import Data.Maybe
-import Data.Map (Map)
 
-srcModUrl :: SourceURLs -> String
-srcModUrl (_, mModUrl, _, _) = fromMaybe defaultModuleSourceUrl mModUrl
+hypSrcDir :: FilePath
+hypSrcDir = "src"
 
-srcNameUrlMap :: SourceURLs -> Map PackageKey FilePath
-srcNameUrlMap (_, _, nameUrlMap, _) = nameUrlMap
+hypSrcModuleFile :: Module -> FilePath
+hypSrcModuleFile = hypSrcModuleFile' . moduleName
+
+hypSrcModuleFile' :: ModuleName -> FilePath
+hypSrcModuleFile' mdl = spliceURL'
+    Nothing (Just mdl) Nothing Nothing moduleFormat
+
+hypSrcModuleUrl :: Module -> String
+hypSrcModuleUrl = hypSrcModuleFile
+
+hypSrcModuleUrl' :: ModuleName -> String
+hypSrcModuleUrl' = hypSrcModuleFile'
+
+hypSrcNameUrl :: Name -> String
+hypSrcNameUrl name = spliceURL
+    Nothing Nothing (Just name) Nothing nameFormat
+
+hypSrcModuleNameUrl :: Module -> Name -> String
+hypSrcModuleNameUrl mdl name = hypSrcModuleUrl mdl ++ "#" ++ hypSrcNameUrl name
+
+hypSrcModuleUrlFormat :: String
+hypSrcModuleUrlFormat = hypSrcDir </> moduleFormat
+
+hypSrcModuleNameUrlFormat :: String
+hypSrcModuleNameUrlFormat = hypSrcModuleUrlFormat ++ "#" ++ nameFormat
+
+moduleFormat :: String
+moduleFormat = "%{MODULE}.html"
+
+nameFormat :: String
+nameFormat = "%{NAME}"
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
index cbcbbd6da8..36ecf86322 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
@@ -14,7 +14,7 @@ module Haddock.Backends.Xhtml.Utils (
   renderToString,
 
   namedAnchor, linkedAnchor,
-  spliceURL,
+  spliceURL, spliceURL',
   groupId,
 
   (<+>), (<=>), char,
@@ -29,7 +29,6 @@ module Haddock.Backends.Xhtml.Utils (
 ) where
 
 
-import Haddock.GhcUtils
 import Haddock.Utils
 
 import Data.Maybe
@@ -38,18 +37,23 @@ import Text.XHtml hiding ( name, title, p, quote )
 import qualified Text.XHtml as XHtml
 
 import GHC      ( SrcSpan(..), srcSpanStartLine, Name )
-import Module   ( Module )
+import Module   ( Module, ModuleName, moduleName, moduleNameString )
 import Name     ( getOccString, nameOccName, isValOcc )
 
 
 spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name ->
              Maybe SrcSpan -> String -> String
-spliceURL maybe_file maybe_mod maybe_name maybe_loc = run
+spliceURL mfile mmod = spliceURL' mfile (moduleName <$> mmod)
+
+
+spliceURL' :: Maybe FilePath -> Maybe ModuleName -> Maybe GHC.Name ->
+              Maybe SrcSpan -> String -> String
+spliceURL' maybe_file maybe_mod maybe_name maybe_loc = run
  where
   file = fromMaybe "" maybe_file
   mdl = case maybe_mod of
           Nothing           -> ""
-          Just m -> moduleString m
+          Just m -> moduleNameString m
 
   (name, kind) =
     case maybe_name of
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 047d9fd0f2..4fed3a1ee7 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -29,7 +29,6 @@ module Haddock.Utils (
   moduleNameUrl, moduleNameUrl', moduleUrl,
   nameAnchorId,
   makeAnchorId,
-  defaultModuleSourceUrl, defaultNameSourceUrl,
 
   -- * Miscellaneous utilities
   getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr,
@@ -278,13 +277,6 @@ makeAnchorId (f:r) = escape isAlpha f ++ concatMap (escape isLegal) r
        -- NB: '-' is legal in IDs, but we use it as the escape char
 
 
-defaultModuleSourceUrl :: String
-defaultModuleSourceUrl = "src/%{MODULE}.html"
-
-defaultNameSourceUrl :: String
-defaultNameSourceUrl = defaultModuleSourceUrl ++ "#%{NAME}"
-
-
 -------------------------------------------------------------------------------
 -- * Files we need to copy from our $libdir
 -------------------------------------------------------------------------------

From a6eb5a19b13bc4dfa79d0e55e5992dfa403aa3c3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 28 Jun 2015 21:00:55 +0200
Subject: [PATCH 046/109] Add basic support for cross-package hyperlink
 generation.

---
 haddock-api/src/Haddock.hs                    |  2 +-
 .../src/Haddock/Backends/Hyperlinker.hs       | 25 +++++------
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 42 ++++++++++++-------
 3 files changed, 40 insertions(+), 29 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index d596c075f7..caaa1eef1d 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -321,7 +321,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do
                   libDir
 
   when (Flag_HyperlinkedSource `elem` flags) $ do
-    ppHyperlinkedSource odir libDir opt_source_css visibleIfaces
+    ppHyperlinkedSource odir libDir opt_source_css pkgKey srcMap visibleIfaces
 
 -- | From GHC 7.10, this function has a potential to crash with a
 -- nasty message such as @expectJust getPackageDetails@ because
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index f197eaa3d6..f2caa2c1c1 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -8,33 +8,34 @@ import Haddock.Backends.Hyperlinker.Renderer
 import Haddock.Backends.Hyperlinker.Utils
 
 import Text.XHtml hiding ((</>))
+import GHC
 
 import Data.Maybe
 import System.Directory
 import System.FilePath
 
-ppHyperlinkedSource :: FilePath -> FilePath
-                    -> Maybe FilePath
-                    -> [Interface]
+ppHyperlinkedSource :: FilePath -> FilePath -> Maybe FilePath
+                    -> PackageKey -> SrcMap -> [Interface]
                     -> IO ()
-ppHyperlinkedSource outdir libdir mstyle ifaces = do
+ppHyperlinkedSource outdir libdir mstyle pkg srcs ifaces = do
     createDirectoryIfMissing True srcdir
     let cssFile = fromMaybe (defaultCssFile libdir) mstyle
     copyFile cssFile $ srcdir </> srcCssFile
     copyFile (libdir </> "html" </> highlightScript) $
         srcdir </> highlightScript
-    mapM_ (ppHyperlinkedModuleSource srcdir) ifaces
+    mapM_ (ppHyperlinkedModuleSource srcdir pkg srcs) ifaces
   where
     srcdir = outdir </> hypSrcDir
 
-ppHyperlinkedModuleSource :: FilePath -> Interface -> IO ()
-ppHyperlinkedModuleSource srcdir iface = case ifaceTokenizedSrc iface of
-    Just tokens ->
-        writeFile path $ showHtml . render mCssFile mJsFile $ tokens
-    Nothing -> return ()
+ppHyperlinkedModuleSource :: FilePath
+                          -> PackageKey -> SrcMap -> Interface
+                          -> IO ()
+ppHyperlinkedModuleSource srcdir pkg srcs iface =
+    case ifaceTokenizedSrc iface of
+        Just tokens -> writeFile path . showHtml . render' $ tokens
+        Nothing -> return ()
   where
-    mCssFile = Just $ srcCssFile
-    mJsFile = Just $ highlightScript
+    render' = render (Just srcCssFile) (Just highlightScript) pkg srcs
     path = srcdir </> hypSrcModuleFile (ifaceMod iface)
 
 srcCssFile :: FilePath
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index d8ea5ec71e..b05a5b8a0a 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -1,5 +1,6 @@
 module Haddock.Backends.Hyperlinker.Renderer (render) where
 
+import Haddock.Types
 import Haddock.Backends.Hyperlinker.Parser
 import Haddock.Backends.Hyperlinker.Ast
 import Haddock.Backends.Hyperlinker.Utils
@@ -8,20 +9,25 @@ import qualified GHC
 import qualified Name as GHC
 import qualified Unique as GHC
 
+import System.FilePath.Posix ((</>))
+
 import Data.List
 import Data.Maybe
 import Data.Monoid
+import qualified Data.Map as Map
 
 import Text.XHtml (Html, HtmlAttr, (!))
 import qualified Text.XHtml as Html
 
 type StyleClass = String
 
-render :: Maybe FilePath -> Maybe FilePath -> [RichToken] -> Html
-render mcss mjs tokens = header mcss mjs <> body tokens
+render :: Maybe FilePath -> Maybe FilePath
+       -> GHC.PackageKey -> SrcMap -> [RichToken]
+       -> Html
+render mcss mjs pkg srcs tokens = header mcss mjs <> body pkg srcs tokens
 
-body :: [RichToken] -> Html
-body = Html.body . Html.pre . mconcat . map richToken
+body :: GHC.PackageKey -> SrcMap -> [RichToken] -> Html
+body pkg srcs = Html.body . Html.pre . mconcat . map (richToken pkg srcs)
 
 header :: Maybe FilePath -> Maybe FilePath -> Html
 header mcss mjs
@@ -41,13 +47,13 @@ header mcss mjs =
         , Html.src scriptFile
         ]
 
-richToken :: RichToken -> Html
-richToken (RichToken tok Nothing) =
+richToken :: GHC.PackageKey -> SrcMap -> RichToken -> Html
+richToken _ _ (RichToken tok Nothing) =
     tokenSpan tok ! attrs
   where
     attrs = [ multiclass . tokenStyle . tkType $ tok ]
-richToken (RichToken tok (Just det)) =
-    externalAnchor det . internalAnchor det . hyperlink det $ content
+richToken pkg srcs (RichToken tok (Just det)) =
+    externalAnchor det . internalAnchor det . hyperlink pkg srcs det $ content
   where
     content = tokenSpan tok ! [ multiclass style]
     style = (tokenStyle . tkType) tok ++ richTokenStyle det
@@ -94,25 +100,29 @@ externalAnchorIdent = hypSrcNameUrl
 internalAnchorIdent :: GHC.Name -> String
 internalAnchorIdent = ("local-" ++) . show . GHC.getKey . GHC.nameUnique
 
-hyperlink :: TokenDetails -> Html -> Html
-hyperlink details = case rtkName details of
+hyperlink :: GHC.PackageKey -> SrcMap -> TokenDetails -> Html -> Html
+hyperlink pkg srcs details = case rtkName details of
     Left name ->
         if GHC.isInternalName name
         then internalHyperlink name
-        else externalNameHyperlink name
+        else externalNameHyperlink pkg srcs name
     Right name -> externalModHyperlink name
 
 internalHyperlink :: GHC.Name -> Html -> Html
 internalHyperlink name content =
     Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ]
 
-externalNameHyperlink :: GHC.Name -> Html -> Html
-externalNameHyperlink name content =
-    Html.anchor content ! [ Html.href href ]
+externalNameHyperlink :: GHC.PackageKey -> SrcMap -> GHC.Name -> Html -> Html
+externalNameHyperlink pkg srcs name content
+    | namePkg == pkg = Html.anchor content !
+        [ Html.href $ hypSrcModuleNameUrl mdl name ]
+    | Just path <- Map.lookup namePkg srcs = Html.anchor content !
+        [ Html.href $ path </> hypSrcModuleNameUrl mdl name ]
+    | otherwise = content
   where
-    href = hypSrcModuleNameUrl (GHC.nameModule name) name
+    mdl = GHC.nameModule name
+    namePkg = GHC.modulePackageKey mdl
 
 externalModHyperlink :: GHC.ModuleName -> Html -> Html
 externalModHyperlink mdl content =
     Html.anchor content ! [ Html.href $ hypSrcModuleUrl' mdl ]
-

From 98cb99c2398a2e2b4467da0a1755d24422384f14 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 28 Jun 2015 21:33:03 +0200
Subject: [PATCH 047/109] Disable generating hyperlinks for module references.

---
 .../src/Haddock/Backends/Hyperlinker/Renderer.hs      | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index b05a5b8a0a..89d9b60d14 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -123,6 +123,13 @@ externalNameHyperlink pkg srcs name content
     mdl = GHC.nameModule name
     namePkg = GHC.modulePackageKey mdl
 
+-- TODO: Implement module hyperlinks.
+--
+-- Unfortunately, 'ModuleName' is not enough to provide viable cross-package
+-- hyperlink. And the problem is that GHC AST does not have other information
+-- on imported modules, so for the time being, we do not provide such reference
+-- either.
 externalModHyperlink :: GHC.ModuleName -> Html -> Html
-externalModHyperlink mdl content =
-    Html.anchor content ! [ Html.href $ hypSrcModuleUrl' mdl ]
+externalModHyperlink _ content =
+    content
+    --Html.anchor content ! [ Html.href $ hypSrcModuleUrl' mdl ]

From 4a6b6c18dbb6542b64f13e4f51cc0447df15a175 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 28 Jun 2015 21:45:29 +0200
Subject: [PATCH 048/109] Make Haddock generate source for all interfaces (also
 hidden ones).

---
 haddock-api/src/Haddock.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index caaa1eef1d..c76966fc07 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -321,7 +321,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do
                   libDir
 
   when (Flag_HyperlinkedSource `elem` flags) $ do
-    ppHyperlinkedSource odir libDir opt_source_css pkgKey srcMap visibleIfaces
+    ppHyperlinkedSource odir libDir opt_source_css pkgKey srcMap ifaces
 
 -- | From GHC 7.10, this function has a potential to crash with a
 -- nasty message such as @expectJust getPackageDetails@ because

From 311b3cc529097ef83a8212439dafcabb86534c62 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 28 Jun 2015 22:28:00 +0200
Subject: [PATCH 049/109] Prevent source parser from throwing exception when
 lexing fails.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 6e195dba5b..bab5ba0a66 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -63,7 +63,9 @@ chunk str@(c:_)
 chunk str
     | "--" `isPrefixOf` str = chunk' $ spanToNewline str
     | "{-" `isPrefixOf` str = chunk' $ chunkComment 0 str
-    | otherwise = chunk' $ head $ lex str
+    | otherwise = case lex str of
+        (tok:_) -> chunk' tok
+        [] -> [str]
   where
     chunk' (c, rest) = c:(chunk rest)
 

From 6cf5e45135ad48f140a76054b38e13eb83491d2a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 28 Jun 2015 23:13:05 +0200
Subject: [PATCH 050/109] Implement workaround for Chrome highlighting issues.

---
 haddock-api/resources/html/highlight.js | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/haddock-api/resources/html/highlight.js b/haddock-api/resources/html/highlight.js
index 639cf5d57a..a538feae3f 100644
--- a/haddock-api/resources/html/highlight.js
+++ b/haddock-api/resources/html/highlight.js
@@ -3,6 +3,10 @@ var styleForRule = function (rule) {
 	var sheets = document.styleSheets;
 	for (var s = 0; s < sheets.length; s++) {
 		var rules = sheets[s].cssRules;
+		if (rules === null) {
+			return null;
+		}
+
 		for (var r = 0; r < rules.length; r++) {
 			if (rules[r].selectorText == rule) {
 				return rules[r].style;
@@ -12,7 +16,13 @@ var styleForRule = function (rule) {
 };
 
 var highlight = function () {
-	var color = styleForRule("a:hover")["background-color"];
+	/*
+	 * Chrome for security reasons disallows to read .cssRules property.
+	 * So, we are forced to pick some color and set it as a highlight.
+	 */
+	var style = styleForRule("a:hover");
+	var color = style !== null ? style["background-color"] : "#808080";
+
 	var links = document.getElementsByTagName('a');
 	for (var i = 0; i < links.length; i++) {
 		var that = links[i];

From 5a86381db3d73b4b68fdaae5c150a84e91e80c09 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 29 Jun 2015 16:10:03 +0200
Subject: [PATCH 051/109] Make hyperlinker generate correct anchors for data
 constructors.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 275f10e97b..c32bb72218 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -107,17 +107,22 @@ binds =
 -- | Obtain details map for top-level declarations.
 decls :: GHC.RenamedSource -> DetailsMap
 decls (group, _, _, _) = concatMap ($ group)
-    [ map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
+    [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
     , everything (<|>) fun
     ]
   where
-    typ (GHC.L _ t) =
-        let (GHC.L sspan name) = GHC.tcdLName t
-        in (sspan, RtkDecl name)
+    typ (GHC.L _ t) = case t of
+        GHC.DataDecl (GHC.L sspan name) _ defn _ ->
+            [(sspan, RtkDecl name)] ++ concatMap con (GHC.dd_cons defn)
+        _ ->
+            let (GHC.L sspan name) = GHC.tcdLName t
+            in pure (sspan, RtkDecl name)
     fun term = case cast term of
         (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name))
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)
         _ -> empty
+    con (GHC.L _ t) = flip map (GHC.con_names t) $
+        \(GHC.L sspan name) -> (sspan, RtkDecl name)
 
 -- | Obtain details map for import declarations.
 --

From 46b1520fcc8ef56825bd42ecf1c1fa8ec899ee58 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 29 Jun 2015 17:33:59 +0200
Subject: [PATCH 052/109] Make hyperlinker generate anchors for record field
 declarations.

---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs      | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index c32bb72218..5efcd2ed4e 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -112,17 +112,19 @@ decls (group, _, _, _) = concatMap ($ group)
     ]
   where
     typ (GHC.L _ t) = case t of
-        GHC.DataDecl (GHC.L sspan name) _ defn _ ->
-            [(sspan, RtkDecl name)] ++ concatMap con (GHC.dd_cons defn)
-        _ ->
-            let (GHC.L sspan name) = GHC.tcdLName t
-            in pure (sspan, RtkDecl name)
+        GHC.DataDecl name _ defn _ ->
+            [decl name] ++ concatMap con (GHC.dd_cons defn)
+        _ -> pure . decl $ GHC.tcdLName t
     fun term = case cast term of
         (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name))
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)
         _ -> empty
-    con (GHC.L _ t) = flip map (GHC.con_names t) $
-        \(GHC.L sspan name) -> (sspan, RtkDecl name)
+    con (GHC.L _ t) =
+        map decl (GHC.con_names t) ++ everything (<|>) fld t
+    fld term = case cast term of
+        Just field -> map decl $ GHC.cd_fld_names field
+        Nothing -> empty
+    decl (GHC.L sspan name) = (sspan, RtkDecl name)
 
 -- | Obtain details map for import declarations.
 --

From 671e7dc60266d1e0fdabd34956719961c1333fb3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 29 Jun 2015 20:33:18 +0200
Subject: [PATCH 053/109] Fix issue with hyperlink highlight styling in Chrome
 browser.

---
 haddock-api/resources/html/highlight.js  | 57 ++++++------------------
 haddock-api/resources/html/solarized.css |  2 +-
 2 files changed, 15 insertions(+), 44 deletions(-)

diff --git a/haddock-api/resources/html/highlight.js b/haddock-api/resources/html/highlight.js
index a538feae3f..1e903bd0c5 100644
--- a/haddock-api/resources/html/highlight.js
+++ b/haddock-api/resources/html/highlight.js
@@ -1,48 +1,19 @@
 
-var styleForRule = function (rule) {
-	var sheets = document.styleSheets;
-	for (var s = 0; s < sheets.length; s++) {
-		var rules = sheets[s].cssRules;
-		if (rules === null) {
-			return null;
-		}
+var highlight = function (on) {
+	return function () {
+		var links = document.getElementsByTagName('a');
+		for (var i = 0; i < links.length; i++) {
+			var that = links[i];
 
-		for (var r = 0; r < rules.length; r++) {
-			if (rules[r].selectorText == rule) {
-				return rules[r].style;
+			if (this.href != that.href) {
+				continue;
 			}
-		}
-	}
-};
-
-var highlight = function () {
-	/*
-	 * Chrome for security reasons disallows to read .cssRules property.
-	 * So, we are forced to pick some color and set it as a highlight.
-	 */
-	var style = styleForRule("a:hover");
-	var color = style !== null ? style["background-color"] : "#808080";
-
-	var links = document.getElementsByTagName('a');
-	for (var i = 0; i < links.length; i++) {
-		var that = links[i];
-		if (this.href == that.href) {
-			that.style["background-color"] = color;
-		}
-	}
-};
 
-/*
- * I have no idea what is the proper antonym for "highlight" in this
- * context. "Diminish"? "Unhighlight"? "Lowlight" sounds ridiculously
- * so I like it.
- */
-var lowlight = function () {
-	var links = document.getElementsByTagName('a');
-	for (var i = 0; i < links.length; i++) {
-		var that = links[i];
-		if (this.href == that.href) {
-			that.style["background-color"] = "";
+			if (on) {
+				that.classList.add("hover-highlight");
+			} else {
+				that.classList.remove("hover-highlight");
+			}
 		}
 	}
 };
@@ -50,7 +21,7 @@ var lowlight = function () {
 window.onload = function () {
 	var links = document.getElementsByTagName('a');
 	for (var i = 0; i < links.length; i++) {
-		links[i].onmouseover = highlight;
-		links[i].onmouseout = lowlight;
+		links[i].onmouseover = highlight(true);
+		links[i].onmouseout = highlight(false);
 	}
 };
diff --git a/haddock-api/resources/html/solarized.css b/haddock-api/resources/html/solarized.css
index e4bff385d4..e83dc5ec70 100644
--- a/haddock-api/resources/html/solarized.css
+++ b/haddock-api/resources/html/solarized.css
@@ -50,6 +50,6 @@ a:link, a:visited {
 	border-bottom: 1px solid #eee8d5;
 }
 
-a:hover {
+a:hover, a.hover-highlight {
 	background-color: #eee8d5;
 }

From d6cfd266b30066a5452514b26e50b740104a982b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 29 Jun 2015 23:00:54 +0200
Subject: [PATCH 054/109] Add support for hyperlinking constructor names in
 patters.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 5efcd2ed4e..fd3f2f1e8f 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -102,6 +102,8 @@ binds =
     pat term = case cast term of
         (Just (GHC.L sspan (GHC.VarPat name))) ->
             pure (sspan, RtkBind name)
+        (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) _))) ->
+            pure (sspan, RtkVar name)
         _ -> empty
 
 -- | Obtain details map for top-level declarations.

From a1d3cb1d86340cd670e50f88e1cb8bf4a4e64f7b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 29 Jun 2015 23:15:26 +0200
Subject: [PATCH 055/109] Add support for hyperlinking field names in record
 patterns.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index fd3f2f1e8f..3b0e0f4437 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -102,7 +102,11 @@ binds =
     pat term = case cast term of
         (Just (GHC.L sspan (GHC.VarPat name))) ->
             pure (sspan, RtkBind name)
-        (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) _))) ->
+        (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) recs))) ->
+            [(sspan, RtkVar name)] ++ everything (<|>) rec recs
+        _ -> empty
+    rec term = case cast term of
+        (Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LPat GHC.Name) _)) ->
             pure (sspan, RtkVar name)
         _ -> empty
 

From 7d269444ea9c55a2b364ead45fe06d435fa078b2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 29 Jun 2015 23:41:10 +0200
Subject: [PATCH 056/109] Add support for hyperlinking field names in record
 expressions.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 3b0e0f4437..c41b5e5fe9 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -69,11 +69,17 @@ enrichToken _ _ = Nothing
 -- | Obtain details map for variables ("normally" used identifiers).
 variables :: GHC.RenamedSource -> DetailsMap
 variables =
-    everything (<|>) var
+    everything (<|>) (var `combine` rec)
   where
     var term = case cast term of
         (Just (GHC.L sspan (GHC.HsVar name))) ->
             pure (sspan, RtkVar name)
+        (Just (GHC.L _ (GHC.RecordCon (GHC.L sspan name) _ _))) ->
+            pure (sspan, RtkVar name)
+        _ -> empty
+    rec term = case cast term of
+        Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LHsExpr GHC.Name) _) ->
+            pure (sspan, RtkVar name)
         _ -> empty
 
 -- | Obtain details map for types.

From 6bebd572bc673d10ed68096f935cdc5a9d1839b5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Tue, 30 Jun 2015 21:58:08 +0200
Subject: [PATCH 057/109] Make hyperlinker respect pretty-printer flag and add
 documentation.

---
 haddock-api/src/Haddock.hs                    |  2 +-
 .../src/Haddock/Backends/Hyperlinker.hs       | 30 ++++++++++++++-----
 2 files changed, 24 insertions(+), 8 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index c76966fc07..02e1953124 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -321,7 +321,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do
                   libDir
 
   when (Flag_HyperlinkedSource `elem` flags) $ do
-    ppHyperlinkedSource odir libDir opt_source_css pkgKey srcMap ifaces
+    ppHyperlinkedSource odir libDir opt_source_css pretty pkgKey srcMap ifaces
 
 -- | From GHC 7.10, this function has a potential to crash with a
 -- nasty message such as @expectJust getPackageDetails@ because
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index f2caa2c1c1..1fadef4976 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -14,35 +14,51 @@ import Data.Maybe
 import System.Directory
 import System.FilePath
 
-ppHyperlinkedSource :: FilePath -> FilePath -> Maybe FilePath
-                    -> PackageKey -> SrcMap -> [Interface]
+
+-- | Generate hyperlinked source for given interfaces.
+--
+-- Note that list of interfaces should also contain interfaces normally hidden
+-- when generating documentation. Otherwise this could lead to dead links in
+-- produced source.
+ppHyperlinkedSource :: FilePath -- ^ Output directory
+                    -> FilePath -- ^ Resource directory
+                    -> Maybe FilePath -- ^ Custom CSS file path
+                    -> Bool -- ^ Flag indicating whether to pretty-print HTML
+                    -> PackageKey -- ^ Package for which we create source
+                    -> SrcMap -- ^ Paths to external sources
+                    -> [Interface] -- ^ Interfaces for which we create source
                     -> IO ()
-ppHyperlinkedSource outdir libdir mstyle pkg srcs ifaces = do
+ppHyperlinkedSource outdir libdir mstyle pretty pkg srcs ifaces = do
     createDirectoryIfMissing True srcdir
     let cssFile = fromMaybe (defaultCssFile libdir) mstyle
     copyFile cssFile $ srcdir </> srcCssFile
     copyFile (libdir </> "html" </> highlightScript) $
         srcdir </> highlightScript
-    mapM_ (ppHyperlinkedModuleSource srcdir pkg srcs) ifaces
+    mapM_ (ppHyperlinkedModuleSource srcdir pretty pkg srcs) ifaces
   where
     srcdir = outdir </> hypSrcDir
 
-ppHyperlinkedModuleSource :: FilePath
+-- | Generate hyperlinked source for particular interface.
+ppHyperlinkedModuleSource :: FilePath -> Bool
                           -> PackageKey -> SrcMap -> Interface
                           -> IO ()
-ppHyperlinkedModuleSource srcdir pkg srcs iface =
+ppHyperlinkedModuleSource srcdir pretty pkg srcs iface =
     case ifaceTokenizedSrc iface of
-        Just tokens -> writeFile path . showHtml . render' $ tokens
+        Just tokens -> writeFile path . html . render' $ tokens
         Nothing -> return ()
   where
     render' = render (Just srcCssFile) (Just highlightScript) pkg srcs
+    html = if pretty then renderHtml else showHtml
     path = srcdir </> hypSrcModuleFile (ifaceMod iface)
 
+-- | Name of CSS file in output directory.
 srcCssFile :: FilePath
 srcCssFile = "style.css"
 
+-- | Name of highlight script in output and resource directory.
 highlightScript :: FilePath
 highlightScript = "highlight.js"
 
+-- | Path to default CSS file.
 defaultCssFile :: FilePath -> FilePath
 defaultCssFile libdir = libdir </> "html" </> "solarized.css"

From fe22edadb6071e0b8e83c2ddff21d28bbe922a68 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Tue, 30 Jun 2015 22:00:14 +0200
Subject: [PATCH 058/109] Unexpose hyperlinker modules in Cabal configuration.

---
 haddock-api/haddock-api.cabal | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 7670f888cb..23c4497aba 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -59,9 +59,6 @@ library
 
   exposed-modules:
     Documentation.Haddock
-    Haddock.Backends.Hyperlinker.Parser
-    Haddock.Backends.Hyperlinker.Renderer
-    Haddock.Backends.Hyperlinker.Ast
 
   other-modules:
     Haddock
@@ -85,6 +82,9 @@ library
     Haddock.Backends.HaddockDB
     Haddock.Backends.Hoogle
     Haddock.Backends.Hyperlinker
+    Haddock.Backends.Hyperlinker.Ast
+    Haddock.Backends.Hyperlinker.Parser
+    Haddock.Backends.Hyperlinker.Renderer
     Haddock.Backends.Hyperlinker.Utils
     Haddock.ModuleTree
     Haddock.Types

From d44fc5b2b40e26e76d2fe7ac0a47bea84154cf67 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 28 Jun 2015 00:00:33 +0200
Subject: [PATCH 059/109] Setup HSpec framework for Haddock API package.

---
 haddock-api/haddock-api.cabal                 | 31 +++++++++++++++++++
 .../Backends/Hyperlinker/ParserSpec.hs        | 17 ++++++++++
 haddock-api/test/Spec.hs                      |  1 +
 3 files changed, 49 insertions(+)
 create mode 100644 haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
 create mode 100644 haddock-api/test/Spec.hs

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 23c4497aba..56889e664b 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -96,6 +96,37 @@ library
     Haddock.Convert
     Paths_haddock_api
 
+test-suite spec
+  type:             exitcode-stdio-1.0
+  default-language: Haskell2010
+  main-is:          Spec.hs
+  ghc-options: -Wall
+
+  hs-source-dirs:
+      test
+    , src
+
+  other-modules:
+    Haddock.Backends.Hyperlinker.ParserSpec
+
+  build-depends:
+      base >= 4.3 && < 4.9
+    , bytestring
+    , filepath
+    , directory
+    , containers
+    , deepseq
+    , array
+    , xhtml >= 3000.2 && < 3000.3
+    , Cabal >= 1.10
+    , ghc >= 7.10 && < 7.10.2
+
+    , ghc-paths
+    , haddock-library == 1.2.*
+
+    , hspec
+    , QuickCheck == 2.*
+
 source-repository head
   type:     git
   location: https://github.com/haskell/haddock.git
diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
new file mode 100644
index 0000000000..c85fa47e20
--- /dev/null
+++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
@@ -0,0 +1,17 @@
+module Haddock.Backends.Hyperlinker.ParserSpec (main, spec) where
+
+
+import Test.Hspec
+
+import Haddock.Backends.Hyperlinker.Parser
+
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = do
+    describe "parse" parseSpec
+
+parseSpec :: Spec
+parseSpec = return ()
diff --git a/haddock-api/test/Spec.hs b/haddock-api/test/Spec.hs
new file mode 100644
index 0000000000..a824f8c30c
--- /dev/null
+++ b/haddock-api/test/Spec.hs
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

From f3d1f3cbd6e99f5d477a78e05c13b65b9e8b3fae Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 28 Jun 2015 00:49:17 +0200
Subject: [PATCH 060/109] Add basic tests related to comment parsing.

---
 .../Haddock/Backends/Hyperlinker/Parser.hs    |  2 +-
 .../Backends/Hyperlinker/ParserSpec.hs        | 37 ++++++++++++++++++-
 2 files changed, 37 insertions(+), 2 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index bab5ba0a66..019075a199 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -38,7 +38,7 @@ data TokenType
     | TkCpp
     | TkPragma
     | TkUnknown
-    deriving (Eq)
+    deriving (Show, Eq)
 
 -- | Turn source code string into a stream of more descriptive tokens.
 --
diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
index c85fa47e20..d596422474 100644
--- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
+++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
@@ -9,9 +9,44 @@ import Haddock.Backends.Hyperlinker.Parser
 main :: IO ()
 main = hspec spec
 
+
 spec :: Spec
 spec = do
     describe "parse" parseSpec
 
+
 parseSpec :: Spec
-parseSpec = return ()
+parseSpec = do
+
+    context "when parsing single-line comments" $ do
+
+        it "should ignore content until the end of line" $
+            "-- some very simple comment\nidentifier"
+            `shouldParseTo`
+            [TkComment, TkSpace, TkIdentifier]
+
+        it "should allow endline escaping" $
+            "-- first line\\\nsecond line\\\nand another one"
+            `shouldParseTo`
+            [TkComment]
+
+    context "when parsing multi-line comments" $ do
+
+        it "should support nested comments" $
+            "{- comment {- nested -} still comment -} {- next comment -}"
+            `shouldParseTo`
+            [TkComment, TkSpace, TkComment]
+
+        it "should distinguish compiler pragma" $
+            "{- comment -}{-# LANGUAGE GADTs #-}{- comment -}"
+            `shouldParseTo`
+            [TkComment, TkPragma, TkComment]
+
+    it "should recognize preprocessor directives" $ do
+        "\n#define foo bar" `shouldParseTo` [TkSpace, TkCpp]
+        "x # y" `shouldParseTo`
+            [TkIdentifier, TkSpace, TkCpp, TkSpace,TkIdentifier]
+
+
+shouldParseTo :: String -> [TokenType] -> Expectation
+str `shouldParseTo` tokens = map tkType (parse str) `shouldBe` tokens

From 86ccbbf208fad2b27d2d76d9a32a80b452274d2e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 28 Jun 2015 12:41:08 +0200
Subject: [PATCH 061/109] Add tests related to parsing basic language
 constructs.

---
 .../Backends/Hyperlinker/ParserSpec.hs        | 20 +++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
index d596422474..fa880a3711 100644
--- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
+++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
@@ -47,6 +47,26 @@ parseSpec = do
         "x # y" `shouldParseTo`
             [TkIdentifier, TkSpace, TkCpp, TkSpace,TkIdentifier]
 
+    it "should distinguish basic language constructs" $ do
+        "(* 2) <$> (\"abc\", foo)" `shouldParseTo`
+            [ TkSpecial, TkOperator, TkSpace, TkNumber, TkSpecial
+            , TkSpace, TkOperator, TkSpace
+            , TkSpecial, TkString, TkSpecial, TkSpace, TkIdentifier, TkSpecial
+            ]
+        "let foo' = foo in foo' + foo'" `shouldParseTo`
+            [ TkKeyword, TkSpace, TkIdentifier
+            , TkSpace, TkGlyph, TkSpace
+            , TkIdentifier, TkSpace, TkKeyword, TkSpace
+            , TkIdentifier, TkSpace, TkOperator, TkSpace, TkIdentifier
+            ]
+        "square x = y^2 where y = x" `shouldParseTo`
+            [ TkIdentifier, TkSpace, TkIdentifier
+            , TkSpace, TkGlyph, TkSpace
+            , TkIdentifier, TkOperator, TkNumber
+            , TkSpace, TkKeyword, TkSpace
+            , TkIdentifier, TkSpace, TkGlyph, TkSpace, TkIdentifier
+            ]
+
 
 shouldParseTo :: String -> [TokenType] -> Expectation
 str `shouldParseTo` tokens = map tkType (parse str) `shouldBe` tokens

From 2426a64771339efb4a776799d9bf593d6b8d09a3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 28 Jun 2015 15:54:30 +0200
Subject: [PATCH 062/109] Add simple tests for do-notation parsing.

---
 .../Haddock/Backends/Hyperlinker/ParserSpec.hs | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
index fa880a3711..5e69b446e3 100644
--- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
+++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
@@ -67,6 +67,24 @@ parseSpec = do
             , TkIdentifier, TkSpace, TkGlyph, TkSpace, TkIdentifier
             ]
 
+    it "should parse do-notation syntax" $ do
+        "do { foo <- getLine; putStrLn foo }" `shouldParseTo`
+            [ TkKeyword, TkSpace, TkSpecial, TkSpace
+            , TkIdentifier, TkSpace, TkGlyph, TkSpace
+            , TkIdentifier, TkSpecial, TkSpace
+            , TkIdentifier, TkSpace, TkIdentifier, TkSpace, TkSpecial
+            ]
+
+        unlines
+            [ "do"
+            , "    foo <- getLine"
+            , "    putStrLn foo"
+            ] `shouldParseTo`
+            [ TkKeyword, TkSpace, TkIdentifier
+            , TkSpace, TkGlyph, TkSpace, TkIdentifier, TkSpace
+            , TkIdentifier, TkSpace, TkIdentifier, TkSpace
+            ]
+
 
 shouldParseTo :: String -> [TokenType] -> Expectation
 str `shouldParseTo` tokens = map tkType (parse str) `shouldBe` tokens

From 5ddb425bbdc29efdd314ffc18db6c8e6c3609d24 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 28 Jun 2015 23:58:24 +0200
Subject: [PATCH 063/109] Add very simple QuickCheck properties for source
 parser spec.

---
 .../test/Haddock/Backends/Hyperlinker/ParserSpec.hs        | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
index 5e69b446e3..38cdbc87e2 100644
--- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
+++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
@@ -2,6 +2,7 @@ module Haddock.Backends.Hyperlinker.ParserSpec (main, spec) where
 
 
 import Test.Hspec
+import Test.QuickCheck
 
 import Haddock.Backends.Hyperlinker.Parser
 
@@ -18,6 +19,12 @@ spec = do
 parseSpec :: Spec
 parseSpec = do
 
+    it "is total" $
+        property $ \src -> length (parse src) `shouldSatisfy` (>= 0)
+
+    it "retains file layout" $
+        property $ \src -> concatMap tkValue (parse src) == src
+
     context "when parsing single-line comments" $ do
 
         it "should ignore content until the end of line" $

From 5f13457a8e31f424d797f721e93434e09bc9140a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Tue, 30 Jun 2015 19:38:21 +0200
Subject: [PATCH 064/109] Create simple test runner for hyperlinker tests.

---
 hypsrc-test/run.hs | 119 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 119 insertions(+)
 create mode 100755 hypsrc-test/run.hs

diff --git a/hypsrc-test/run.hs b/hypsrc-test/run.hs
new file mode 100755
index 0000000000..0b97a0752d
--- /dev/null
+++ b/hypsrc-test/run.hs
@@ -0,0 +1,119 @@
+#!/usr/bin/env runhaskell
+{-# LANGUAGE CPP #-}
+
+
+import Control.Applicative
+import Control.Monad
+
+import Data.List
+import Data.Maybe
+
+import System.IO
+import System.Directory
+import System.Environment
+import System.Exit
+import System.FilePath
+import System.Process
+
+import Distribution.Verbosity
+import Distribution.Simple.Utils hiding (die)
+
+
+baseDir, rootDir :: FilePath
+baseDir = takeDirectory __FILE__ 
+rootDir = baseDir </> ".."
+
+srcDir, refDir, outDir :: FilePath
+srcDir = baseDir </> "src"
+refDir = baseDir </> "ref"
+outDir = baseDir </> "out"
+
+haddockPath :: FilePath
+haddockPath = rootDir </> "dist" </> "build" </> "haddock" </> "haddock"
+
+
+main :: IO ()
+main = do
+    haddockAvailable <- doesFileExist haddockPath
+    unless haddockAvailable $ die "Haddock exectuable not available"
+
+    (args, mods) <- partition ("-" `isPrefixOf`) <$> getArgs
+    let args' = filter (\arg -> not $ arg == "--all" || arg == "-a") args
+    mods' <- map (srcDir </>) <$> if "--all" `elem` args || "-a" `elem` args
+        then getAllSrcModules
+        else return mods
+
+    putHaddockVersion
+    putGhcVersion
+
+    putStrLn "Running tests..."
+    runHaddock $
+        [ "--odir=" ++ outDir
+        , "--no-warnings"
+        , "--hyperlinked-source"
+        ] ++ args' ++ mods'
+
+    forM_ mods' $ check True
+
+
+check :: Bool -> FilePath -> IO ()
+check strict mdl = do
+    hasReference <- doesFileExist refFile
+    if hasReference
+    then do
+        out <- readFile outFile
+        ref <- readFile refFile
+        if out == ref
+        then putStrLn $ "Pass: " ++ mdl
+        else do
+            putStrLn $ "Fail: " ++ mdl
+            diff refFile outFile
+            when strict $ die "Aborting further tests."
+    else do
+        putStrLn $ "Pass: " ++ mdl ++ " (no reference file)"
+  where
+    refFile = refDir </> takeBaseName mdl ++ ".html"
+    outFile = outDir </> takeBaseName mdl ++ ".html"
+
+
+diff :: FilePath -> FilePath -> IO ()
+diff fileA fileB = do
+    colorDiffPath <- findProgramLocation silent "colordiff"
+    let cmd = fromMaybe "diff" colorDiffPath
+
+    result <- system $ cmd ++ " " ++ fileA ++ " " ++ fileB
+    unless (result == ExitSuccess) $ die "Failed to run `diff` command."
+
+
+getAllSrcModules :: IO [FilePath]
+getAllSrcModules =
+    filter isValid <$> getDirectoryContents srcDir
+  where
+    isValid = (== ".hs") . takeExtension
+
+
+putHaddockVersion :: IO ()
+putHaddockVersion = do
+    putStrLn "Haddock version:"
+    runHaddock ["--version"]
+    putStrLn ""
+
+
+putGhcVersion :: IO ()
+putGhcVersion = do
+    putStrLn "GHC version:"
+    runHaddock ["--ghc-version"]
+    putStrLn ""
+
+
+runHaddock :: [String] -> IO ()
+runHaddock args = do
+    env <- Just <$> getEnvironment
+    handle <- runProcess haddockPath args Nothing env Nothing Nothing Nothing
+    waitForSuccess handle $ "Failed to invoke haddock with " ++ show args
+
+
+waitForSuccess :: ProcessHandle -> String -> IO ()
+waitForSuccess handle msg = do
+    result <- waitForProcess handle
+    unless (result == ExitSuccess) $ die msg

From 3b6cbe3ac03d03ea9824770a54868e41d8cf13b6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Tue, 30 Jun 2015 19:48:24 +0200
Subject: [PATCH 065/109] Add test case for basic identifier hyperlinking.

---
 hypsrc-test/src/Identifiers.hs | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)
 create mode 100644 hypsrc-test/src/Identifiers.hs

diff --git a/hypsrc-test/src/Identifiers.hs b/hypsrc-test/src/Identifiers.hs
new file mode 100644
index 0000000000..e2d6223dcb
--- /dev/null
+++ b/hypsrc-test/src/Identifiers.hs
@@ -0,0 +1,27 @@
+module Identifiers where
+
+
+foo, bar, baz :: Int -> Int -> Int
+foo x y = x + x * bar y x * y + y
+bar x y = y + x - baz x y - x + y
+baz x y = x * y * y * y * x
+
+quux :: Int -> Int
+quux x = foo (bar x x) (bar x x)
+
+norf :: Int -> Int -> Int -> Int
+norf x y z
+    | x < 0 = quux x
+    | y < 0 = quux y
+    | z < 0 = quux z
+    | otherwise = norf (-x) (-y) (-z)
+
+
+main :: IO ()
+main = do
+    putStrLn . show $ foo x y
+    putStrLn . show $ quux z
+  where
+    x = 10
+    y = 20
+    z = 30

From 15ac1a816a9875591febcf678bbf914a11e5068f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Tue, 30 Jun 2015 20:00:32 +0200
Subject: [PATCH 066/109] Add test case for operator hyperlinking.

---
 hypsrc-test/src/Operators.hs | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)
 create mode 100644 hypsrc-test/src/Operators.hs

diff --git a/hypsrc-test/src/Operators.hs b/hypsrc-test/src/Operators.hs
new file mode 100644
index 0000000000..bc76c2d394
--- /dev/null
+++ b/hypsrc-test/src/Operators.hs
@@ -0,0 +1,18 @@
+module Operators where
+
+
+(+++) :: [a] -> [a] -> [a]
+a +++ b = a ++ b ++ a
+
+($$$) :: [a] -> [a] -> [a]
+a $$$ b = b +++ a
+
+(***) :: [a] -> [a] -> [a]
+(***) a [] = a
+(***) a (_:b) = a +++ (a *** b)
+
+(*/\*) :: [[a]] -> [a] -> [a]
+a */\* b = concatMap (*** b) a
+
+(**/\**) :: [[a]] -> [[a]] -> [[a]]
+a **/\** b = zipWith (*/\*) [a +++ b] (a $$$ b)

From 95dfb7ab280d69d2bc2eb7f9ab0c4c3deae53cc2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Tue, 30 Jun 2015 20:10:08 +0200
Subject: [PATCH 067/109] Add test case for constructor hyperlinking.

---
 hypsrc-test/src/Constructors.hs | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)
 create mode 100644 hypsrc-test/src/Constructors.hs

diff --git a/hypsrc-test/src/Constructors.hs b/hypsrc-test/src/Constructors.hs
new file mode 100644
index 0000000000..c52bdc723a
--- /dev/null
+++ b/hypsrc-test/src/Constructors.hs
@@ -0,0 +1,27 @@
+module Constructors where
+
+
+data Foo
+    = Bar
+    | Baz
+    | Quux Foo Int
+
+newtype Norf = Norf (Foo, [Foo], Foo)
+
+
+bar, baz, quux :: Foo
+bar = Bar
+baz = Baz
+quux = Quux quux 0
+
+
+unfoo :: Foo -> Int
+unfoo Bar = 0
+unfoo Baz = 0
+unfoo (Quux foo n) = 42 * n + unfoo foo
+
+
+unnorf :: Norf -> [Foo]
+unnorf (Norf (Bar, xs, Bar)) = xs
+unnorf (Norf (Baz, xs, Baz)) = reverse xs
+unnorf _ = undefined

From 354d3296371099bad2729cf7b5445d23a107c6c5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Tue, 30 Jun 2015 20:18:42 +0200
Subject: [PATCH 068/109] Add test case for record expressions and patterns
 hyperlinking.

---
 hypsrc-test/src/Records.hs | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)
 create mode 100644 hypsrc-test/src/Records.hs

diff --git a/hypsrc-test/src/Records.hs b/hypsrc-test/src/Records.hs
new file mode 100644
index 0000000000..4118e29698
--- /dev/null
+++ b/hypsrc-test/src/Records.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Records where
+
+
+data Point = Point
+    { x :: !Int
+    , y :: !Int
+    }
+
+
+point :: Int -> Int -> Point
+point x y = Point { x = x, y = y }
+
+
+lengthSqr :: Point -> Int
+lengthSqr (Point { x = x, y = y }) = x * x + y * y
+
+lengthSqr' :: Point -> Int
+lengthSqr' (Point { x, y }) = y * y + x * x
+
+
+translateX, translateY :: Point -> Int -> Point
+translateX p d = p { x = x p + d }
+translateY p d = p { y = y p + d }

From 9dfb3f87cf71042eb883e228a8c6c7f25c743118 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Tue, 30 Jun 2015 20:30:37 +0200
Subject: [PATCH 069/109] Add test case for literal syntax highlighting.

---
 hypsrc-test/src/Literals.hs | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)
 create mode 100644 hypsrc-test/src/Literals.hs

diff --git a/hypsrc-test/src/Literals.hs b/hypsrc-test/src/Literals.hs
new file mode 100644
index 0000000000..997b661561
--- /dev/null
+++ b/hypsrc-test/src/Literals.hs
@@ -0,0 +1,17 @@
+module Literals where
+
+
+str :: String
+str = "str literal"
+
+num :: Num a => a
+num = 0 + 1 + 1010011 * 41231 + 12131
+
+frac :: Fractional a => a
+frac = 42.0000001
+
+list :: [[[[a]]]]
+list = [[], [[]], [[[]]]]
+
+pair :: ((), ((), (), ()), ())
+pair = ((), ((), (), ()), ())

From cddb70986db0f34427cf74cc93352b1ed10ed56b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Tue, 30 Jun 2015 21:18:46 +0200
Subject: [PATCH 070/109] Add hyperlinker test runner to .cabal and .gitignore
 files.

---
 .gitignore    | 1 +
 haddock.cabal | 9 +++++++++
 2 files changed, 10 insertions(+)

diff --git a/.gitignore b/.gitignore
index f07c758d2e..3c9798c1c8 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,6 +2,7 @@
 /haddock-api/dist/
 /haddock-library/dist/
 /html-test/out/
+/hypsrc-test/out/
 /latex-test/out/
 
 /doc/haddock
diff --git a/haddock.cabal b/haddock.cabal
index 0aebefd8f5..01e6a55879 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -29,6 +29,8 @@ extra-source-files:
   haddock-api/src/haddock.sh
   html-test/src/*.hs
   html-test/ref/*.html
+  hypsrc-test/src/*.hs
+  hypsrc-test/ref/*.html
   latex-test/src/Simple/*.hs
   latex-test/ref/Simple/*.tex
   latex-test/ref/Simple/*.sty
@@ -120,6 +122,13 @@ test-suite html-test
   hs-source-dirs:   html-test
   build-depends:    base, directory, process, filepath, Cabal
 
+test-suite hypsrc-test
+  type:             exitcode-stdio-1.0
+  default-language: Haskell2010
+  main-is:          run.hs
+  hs-source-dirs:   hypsrc-test
+  build-depends:    base, directory, process, filepath, Cabal
+
 test-suite latex-test
   type:             exitcode-stdio-1.0
   default-language: Haskell2010

From beab75b0d28117c9b1e56d3a88e8aac70d5bd0b9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Tue, 30 Jun 2015 21:23:31 +0200
Subject: [PATCH 071/109] Adapt hyperlinker test runner to have the same
 interface as HTML one.

---
 hypsrc-test/run.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/hypsrc-test/run.hs b/hypsrc-test/run.hs
index 0b97a0752d..549f33f74f 100755
--- a/hypsrc-test/run.hs
+++ b/hypsrc-test/run.hs
@@ -39,9 +39,9 @@ main = do
 
     (args, mods) <- partition ("-" `isPrefixOf`) <$> getArgs
     let args' = filter (\arg -> not $ arg == "--all" || arg == "-a") args
-    mods' <- map (srcDir </>) <$> if "--all" `elem` args || "-a" `elem` args
-        then getAllSrcModules
-        else return mods
+    mods' <- map (srcDir </>) <$> case args of
+        [] -> getAllSrcModules
+        _ -> return $ map (++ ".hs") mods
 
     putHaddockVersion
     putGhcVersion

From 5da90733ea03cdb935478e0665b45fe44c116728 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Tue, 30 Jun 2015 22:28:12 +0200
Subject: [PATCH 072/109] Fix hyperlinker test runner file paths and add
 pretty-printing option.

---
 hypsrc-test/run.hs | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/hypsrc-test/run.hs b/hypsrc-test/run.hs
index 549f33f74f..e9a38c0c05 100755
--- a/hypsrc-test/run.hs
+++ b/hypsrc-test/run.hs
@@ -20,13 +20,15 @@ import Distribution.Simple.Utils hiding (die)
 
 
 baseDir, rootDir :: FilePath
-baseDir = takeDirectory __FILE__ 
+baseDir = takeDirectory __FILE__
 rootDir = baseDir </> ".."
 
-srcDir, refDir, outDir :: FilePath
+srcDir, refDir, outDir, refDir', outDir' :: FilePath
 srcDir = baseDir </> "src"
 refDir = baseDir </> "ref"
 outDir = baseDir </> "out"
+refDir' = refDir </> "src"
+outDir' = outDir </> "src"
 
 haddockPath :: FilePath
 haddockPath = rootDir </> "dist" </> "build" </> "haddock" </> "haddock"
@@ -51,6 +53,7 @@ main = do
         [ "--odir=" ++ outDir
         , "--no-warnings"
         , "--hyperlinked-source"
+        , "--pretty-html"
         ] ++ args' ++ mods'
 
     forM_ mods' $ check True
@@ -72,8 +75,8 @@ check strict mdl = do
     else do
         putStrLn $ "Pass: " ++ mdl ++ " (no reference file)"
   where
-    refFile = refDir </> takeBaseName mdl ++ ".html"
-    outFile = outDir </> takeBaseName mdl ++ ".html"
+    refFile = refDir' </> takeBaseName mdl ++ ".html"
+    outFile = outDir' </> takeBaseName mdl ++ ".html"
 
 
 diff :: FilePath -> FilePath -> IO ()

From 40d0a050c81ff21949fc7eeede4e0dbb3b1d7c98 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Tue, 30 Jun 2015 22:29:34 +0200
Subject: [PATCH 073/109] Add reference files for hyperlinker test cases.

---
 hypsrc-test/ref/src/Constructors.html | 536 +++++++++++++++++
 hypsrc-test/ref/src/Identifiers.html  | 800 ++++++++++++++++++++++++++
 hypsrc-test/ref/src/Literals.html     | 382 ++++++++++++
 hypsrc-test/ref/src/Operators.html    | 655 +++++++++++++++++++++
 hypsrc-test/ref/src/Records.html      | 646 +++++++++++++++++++++
 5 files changed, 3019 insertions(+)
 create mode 100644 hypsrc-test/ref/src/Constructors.html
 create mode 100644 hypsrc-test/ref/src/Identifiers.html
 create mode 100644 hypsrc-test/ref/src/Literals.html
 create mode 100644 hypsrc-test/ref/src/Operators.html
 create mode 100644 hypsrc-test/ref/src/Records.html

diff --git a/hypsrc-test/ref/src/Constructors.html b/hypsrc-test/ref/src/Constructors.html
new file mode 100644
index 0000000000..713a85f00e
--- /dev/null
+++ b/hypsrc-test/ref/src/Constructors.html
@@ -0,0 +1,536 @@
+<!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
+  ><link rel="stylesheet" type="text/css" href="style.css"
+     /><script type="text/javascript" src="highlight.js"
+    ></script
+    ></head
+  ><body
+  ><pre
+    ><span class="hs-keyword"
+      >module</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >Constructors</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-keyword"
+      >data</span
+      ><span class=""
+      > </span
+      ><a name="Foo"
+      ><a href="Constructors.html#Foo"
+	><span class="hs-identifier"
+	  >Foo</span
+	  ></a
+	></a
+      ><span class=""
+      >
+    </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a name="Bar"
+      ><a href="Constructors.html#Bar"
+	><span class="hs-identifier"
+	  >Bar</span
+	  ></a
+	></a
+      ><span class=""
+      >
+    </span
+      ><span class="hs-glyph"
+      >|</span
+      ><span class=""
+      > </span
+      ><a name="Baz"
+      ><a href="Constructors.html#Baz"
+	><span class="hs-identifier"
+	  >Baz</span
+	  ></a
+	></a
+      ><span class=""
+      >
+    </span
+      ><span class="hs-glyph"
+      >|</span
+      ><span class=""
+      > </span
+      ><a name="Quux"
+      ><a href="Constructors.html#Quux"
+	><span class="hs-identifier"
+	  >Quux</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-keyword"
+      >newtype</span
+      ><span class=""
+      > </span
+      ><a name="Norf"
+      ><a href="Constructors.html#Norf"
+	><span class="hs-identifier"
+	  >Norf</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a name="Norf"
+      ><a href="Constructors.html#Norf"
+	><span class="hs-identifier"
+	  >Norf</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Constructors.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="Constructors.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-identifier"
+      >bar</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >baz</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >quux</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      >
+</span
+      ><a name="bar"
+      ><a href="Constructors.html#bar"
+	><span class="hs-identifier"
+	  >bar</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#Bar"
+      ><span class="hs-identifier hs-var"
+	>Bar</span
+	></a
+      ><span class=""
+      >
+</span
+      ><a name="baz"
+      ><a href="Constructors.html#baz"
+	><span class="hs-identifier"
+	  >baz</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#Baz"
+      ><span class="hs-identifier hs-var"
+	>Baz</span
+	></a
+      ><span class=""
+      >
+</span
+      ><a name="quux"
+      ><a href="Constructors.html#quux"
+	><span class="hs-identifier"
+	  >quux</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#Quux"
+      ><span class="hs-identifier hs-var"
+	>Quux</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#quux"
+      ><span class="hs-identifier hs-var"
+	>quux</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >0</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-identifier"
+      >unfoo</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+</span
+      ><a name="unfoo"
+      ><a href="Constructors.html#unfoo"
+	><span class="hs-identifier"
+	  >unfoo</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#Bar"
+      ><span class="hs-identifier hs-var"
+	>Bar</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >0</span
+      ><span class=""
+      >
+</span
+      ><span class="hs-identifier"
+      >unfoo</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#Baz"
+      ><span class="hs-identifier hs-var"
+	>Baz</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >0</span
+      ><span class=""
+      >
+</span
+      ><span class="hs-identifier"
+      >unfoo</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Constructors.html#Quux"
+      ><span class="hs-identifier hs-var"
+	>Quux</span
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627396015"
+      ><a href="#local-1627396015"
+	><span class="hs-identifier"
+	  >foo</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627396016"
+      ><a href="#local-1627396016"
+	><span class="hs-identifier"
+	  >n</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >42</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627396016"
+      ><span class="hs-identifier hs-var"
+	>n</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#unfoo"
+      ><span class="hs-identifier hs-var"
+	>unfoo</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627396015"
+      ><span class="hs-identifier hs-var"
+	>foo</span
+	></a
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-identifier"
+      >unnorf</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#Norf"
+      ><span class="hs-identifier hs-type"
+	>Norf</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="Constructors.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      >
+</span
+      ><a name="unnorf"
+      ><a href="Constructors.html#unnorf"
+	><span class="hs-identifier"
+	  >unnorf</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Constructors.html#Norf"
+      ><span class="hs-identifier hs-var"
+	>Norf</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Constructors.html#Bar"
+      ><span class="hs-identifier hs-var"
+	>Bar</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a name="local-1627396017"
+      ><a href="#local-1627396017"
+	><span class="hs-identifier"
+	  >xs</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#Bar"
+      ><span class="hs-identifier hs-var"
+	>Bar</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627396017"
+      ><span class="hs-identifier hs-var"
+	>xs</span
+	></a
+      ><span class=""
+      >
+</span
+      ><span class="hs-identifier"
+      >unnorf</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Constructors.html#Norf"
+      ><span class="hs-identifier hs-var"
+	>Norf</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Constructors.html#Baz"
+      ><span class="hs-identifier hs-var"
+	>Baz</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a name="local-1627396018"
+      ><a href="#local-1627396018"
+	><span class="hs-identifier"
+	  >xs</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#Baz"
+      ><span class="hs-identifier hs-var"
+	>Baz</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >reverse</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627396018"
+      ><span class="hs-identifier hs-var"
+	>xs</span
+	></a
+      ><span class=""
+      >
+</span
+      ><span class="hs-identifier"
+      >unnorf</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >_</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >undefined</span
+      ><span class=""
+      >
+</span
+      ></pre
+    ></body
+  ></html
+>
diff --git a/hypsrc-test/ref/src/Identifiers.html b/hypsrc-test/ref/src/Identifiers.html
new file mode 100644
index 0000000000..ee21791fe3
--- /dev/null
+++ b/hypsrc-test/ref/src/Identifiers.html
@@ -0,0 +1,800 @@
+<!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
+  ><link rel="stylesheet" type="text/css" href="style.css"
+     /><script type="text/javascript" src="highlight.js"
+    ></script
+    ></head
+  ><body
+  ><pre
+    ><span class="hs-keyword"
+      >module</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >Identifiers</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-identifier"
+      >foo</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >bar</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >baz</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+</span
+      ><a name="foo"
+      ><a href="Identifiers.html#foo"
+	><span class="hs-identifier"
+	  >foo</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391970"
+      ><a href="#local-1627391970"
+	><span class="hs-identifier"
+	  >x</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391971"
+      ><a href="#local-1627391971"
+	><span class="hs-identifier"
+	  >y</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391970"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391970"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="Identifiers.html#bar"
+      ><span class="hs-identifier hs-var"
+	>bar</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627391971"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627391970"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391971"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391971"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      >
+</span
+      ><a name="bar"
+      ><a href="Identifiers.html#bar"
+	><span class="hs-identifier"
+	  >bar</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391972"
+      ><a href="#local-1627391972"
+	><span class="hs-identifier"
+	  >x</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391973"
+      ><a href="#local-1627391973"
+	><span class="hs-identifier"
+	  >y</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391973"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391972"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-</span
+      ><span class=""
+      > </span
+      ><a href="Identifiers.html#baz"
+      ><span class="hs-identifier hs-var"
+	>baz</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627391972"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627391973"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391972"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391973"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      >
+</span
+      ><a name="baz"
+      ><a href="Identifiers.html#baz"
+	><span class="hs-identifier"
+	  >baz</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391974"
+      ><a href="#local-1627391974"
+	><span class="hs-identifier"
+	  >x</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391975"
+      ><a href="#local-1627391975"
+	><span class="hs-identifier"
+	  >y</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391974"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391975"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391975"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391975"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391974"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-identifier"
+      >quux</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+</span
+      ><a name="quux"
+      ><a href="Identifiers.html#quux"
+	><span class="hs-identifier"
+	  >quux</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391976"
+      ><a href="#local-1627391976"
+	><span class="hs-identifier"
+	  >x</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Identifiers.html#foo"
+      ><span class="hs-identifier hs-var"
+	>foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Identifiers.html#bar"
+      ><span class="hs-identifier hs-var"
+	>bar</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627391976"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627391976"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Identifiers.html#bar"
+      ><span class="hs-identifier hs-var"
+	>bar</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627391976"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627391976"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-identifier"
+      >norf</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+</span
+      ><a name="norf"
+      ><a href="Identifiers.html#norf"
+	><span class="hs-identifier"
+	  >norf</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391977"
+      ><a href="#local-1627391977"
+	><span class="hs-identifier"
+	  >x</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391978"
+      ><a href="#local-1627391978"
+	><span class="hs-identifier"
+	  >y</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391979"
+      ><a href="#local-1627391979"
+	><span class="hs-identifier"
+	  >z</span
+	  ></a
+	></a
+      ><span class=""
+      >
+    </span
+      ><span class="hs-glyph"
+      >|</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391977"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >&lt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >0</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Identifiers.html#quux"
+      ><span class="hs-identifier hs-var"
+	>quux</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627391977"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      >
+    </span
+      ><span class="hs-glyph"
+      >|</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391978"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >&lt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >0</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Identifiers.html#quux"
+      ><span class="hs-identifier hs-var"
+	>quux</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627391978"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      >
+    </span
+      ><span class="hs-glyph"
+      >|</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391979"
+      ><span class="hs-identifier hs-var"
+	>z</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >&lt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >0</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Identifiers.html#quux"
+      ><span class="hs-identifier hs-var"
+	>quux</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627391979"
+      ><span class="hs-identifier hs-var"
+	>z</span
+	></a
+      ><span class=""
+      >
+    </span
+      ><span class="hs-glyph"
+      >|</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >otherwise</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Identifiers.html#norf"
+      ><span class="hs-identifier hs-var"
+	>norf</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-glyph"
+      >-</span
+      ><a href="#local-1627391977"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-glyph"
+      >-</span
+      ><a href="#local-1627391978"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-glyph"
+      >-</span
+      ><a href="#local-1627391979"
+      ><span class="hs-identifier hs-var"
+	>z</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-identifier"
+      >main</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >IO</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+</span
+      ><a name="main"
+      ><a href="Identifiers.html#main"
+	><span class="hs-identifier"
+	  >main</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >do</span
+      ><span class=""
+      >
+    </span
+      ><span class="hs-identifier hs-var"
+      >putStrLn</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >.</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >show</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >$</span
+      ><span class=""
+      > </span
+      ><a href="Identifiers.html#foo"
+      ><span class="hs-identifier hs-var"
+	>foo</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627392781"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627392782"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      >
+    </span
+      ><span class="hs-identifier hs-var"
+      >putStrLn</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >.</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >show</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >$</span
+      ><span class=""
+      > </span
+      ><a href="Identifiers.html#quux"
+      ><span class="hs-identifier hs-var"
+	>quux</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627392783"
+      ><span class="hs-identifier hs-var"
+	>z</span
+	></a
+      ><span class=""
+      >
+  </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+    </span
+      ><a name="local-1627392781"
+      ><a href="#local-1627392781"
+	><span class="hs-identifier"
+	  >x</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >10</span
+      ><span class=""
+      >
+    </span
+      ><a name="local-1627392782"
+      ><a href="#local-1627392782"
+	><span class="hs-identifier"
+	  >y</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >20</span
+      ><span class=""
+      >
+    </span
+      ><a name="local-1627392783"
+      ><a href="#local-1627392783"
+	><span class="hs-identifier"
+	  >z</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >30</span
+      ><span class=""
+      >
+</span
+      ></pre
+    ></body
+  ></html
+>
diff --git a/hypsrc-test/ref/src/Literals.html b/hypsrc-test/ref/src/Literals.html
new file mode 100644
index 0000000000..f854964288
--- /dev/null
+++ b/hypsrc-test/ref/src/Literals.html
@@ -0,0 +1,382 @@
+<!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
+  ><link rel="stylesheet" type="text/css" href="style.css"
+     /><script type="text/javascript" src="highlight.js"
+    ></script
+    ></head
+  ><body
+  ><pre
+    ><span class="hs-keyword"
+      >module</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >Literals</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-identifier"
+      >str</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >String</span
+      ><span class=""
+      >
+</span
+      ><a name="str"
+      ><a href="Literals.html#str"
+	><span class="hs-identifier"
+	  >str</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-string"
+      >&quot;str literal&quot;</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-identifier"
+      >num</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Num</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627395902"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=&gt;</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627395902"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class=""
+      >
+</span
+      ><a name="num"
+      ><a href="Literals.html#num"
+	><span class="hs-identifier"
+	  >num</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >0</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >1</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >1010011</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >41231</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >12131</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-identifier"
+      >frac</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Fractional</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627395418"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=&gt;</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627395418"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class=""
+      >
+</span
+      ><a name="frac"
+      ><a href="Literals.html#frac"
+	><span class="hs-identifier"
+	  >frac</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >42.0000001</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-identifier"
+      >list</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627395417"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      >
+</span
+      ><a name="list"
+      ><a href="Literals.html#list"
+	><span class="hs-identifier"
+	  >list</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-identifier"
+      >pair</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+</span
+      ><a name="pair"
+      ><a href="Literals.html#pair"
+	><span class="hs-identifier"
+	  >pair</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+</span
+      ></pre
+    ></body
+  ></html
+>
diff --git a/hypsrc-test/ref/src/Operators.html b/hypsrc-test/ref/src/Operators.html
new file mode 100644
index 0000000000..04fe4ee45c
--- /dev/null
+++ b/hypsrc-test/ref/src/Operators.html
@@ -0,0 +1,655 @@
+<!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
+  ><link rel="stylesheet" type="text/css" href="style.css"
+     /><script type="text/javascript" src="highlight.js"
+    ></script
+    ></head
+  ><body
+  ><pre
+    ><span class="hs-keyword"
+      >module</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >Operators</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-operator"
+      >+++</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393973"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393973"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393973"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      >
+</span
+      ><a name="local-1627393974"
+      ><a href="#local-1627393974"
+	><span class="hs-identifier"
+	  >a</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="%2B%2B%2B"
+      ><a href="Operators.html#%2B%2B%2B"
+	><span class="hs-operator"
+	  >+++</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627393975"
+      ><a href="#local-1627393975"
+	><span class="hs-identifier"
+	  >b</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627393974"
+      ><span class="hs-identifier hs-var"
+	>a</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >++</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627393975"
+      ><span class="hs-identifier hs-var"
+	>b</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >++</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627393974"
+      ><span class="hs-identifier hs-var"
+	>a</span
+	></a
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-operator"
+      >$$$</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393972"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393972"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393972"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      >
+</span
+      ><a name="local-1627393976"
+      ><a href="#local-1627393976"
+	><span class="hs-identifier"
+	  >a</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="%24%24%24"
+      ><a href="Operators.html#%24%24%24"
+	><span class="hs-operator"
+	  >$$$</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627393977"
+      ><a href="#local-1627393977"
+	><span class="hs-identifier"
+	  >b</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627393977"
+      ><span class="hs-identifier hs-var"
+	>b</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Operators.html#%2B%2B%2B"
+      ><span class="hs-operator hs-var"
+	>+++</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627393976"
+      ><span class="hs-identifier hs-var"
+	>a</span
+	></a
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-operator"
+      >***</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393971"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393971"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393971"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      >
+</span
+      ><span class="hs-special"
+      >(</span
+      ><a name="%2A%2A%2A"
+      ><a href="Operators.html#%2A%2A%2A"
+	><span class="hs-operator"
+	  >***</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><a name="local-1627393978"
+      ><a href="#local-1627393978"
+	><span class="hs-identifier"
+	  >a</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627393978"
+      ><span class="hs-identifier hs-var"
+	>a</span
+	></a
+      ><span class=""
+      >
+</span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-operator"
+      >***</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><a name="local-1627393979"
+      ><a href="#local-1627393979"
+	><span class="hs-identifier"
+	  >a</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-identifier"
+      >_</span
+      ><span class="hs-glyph"
+      >:</span
+      ><a name="local-1627393980"
+      ><a href="#local-1627393980"
+	><span class="hs-identifier"
+	  >b</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627393979"
+      ><span class="hs-identifier hs-var"
+	>a</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Operators.html#%2B%2B%2B"
+      ><span class="hs-operator hs-var"
+	>+++</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="#local-1627393979"
+      ><span class="hs-identifier hs-var"
+	>a</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Operators.html#%2A%2A%2A"
+      ><span class="hs-operator hs-var"
+	>***</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627393980"
+      ><span class="hs-identifier hs-var"
+	>b</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-operator"
+      >*/\*</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393970"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393970"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393970"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      >
+</span
+      ><a name="local-1627393981"
+      ><a href="#local-1627393981"
+	><span class="hs-identifier"
+	  >a</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="%2A%2F%5C%2A"
+      ><a href="Operators.html#%2A%2F%5C%2A"
+	><span class="hs-operator"
+	  >*/\*</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627393982"
+      ><a href="#local-1627393982"
+	><span class="hs-identifier"
+	  >b</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >concatMap</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Operators.html#%2A%2A%2A"
+      ><span class="hs-operator hs-var"
+	>***</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627393982"
+      ><span class="hs-identifier hs-var"
+	>b</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627393981"
+      ><span class="hs-identifier hs-var"
+	>a</span
+	></a
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-operator"
+      >**/\**</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393969"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393969"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627393969"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      >
+</span
+      ><a name="local-1627394362"
+      ><a href="#local-1627394362"
+	><span class="hs-identifier"
+	  >a</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="%2A%2A%2F%5C%2A%2A"
+      ><a href="Operators.html#%2A%2A%2F%5C%2A%2A"
+	><span class="hs-operator"
+	  >**/\**</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627394363"
+      ><a href="#local-1627394363"
+	><span class="hs-identifier"
+	  >b</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >zipWith</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Operators.html#%2A%2F%5C%2A"
+      ><span class="hs-operator hs-var"
+	>*/\*</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-1627394362"
+      ><span class="hs-identifier hs-var"
+	>a</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Operators.html#%2B%2B%2B"
+      ><span class="hs-operator hs-var"
+	>+++</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627394363"
+      ><span class="hs-identifier hs-var"
+	>b</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="#local-1627394362"
+      ><span class="hs-identifier hs-var"
+	>a</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Operators.html#%24%24%24"
+      ><span class="hs-operator hs-var"
+	>$$$</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627394363"
+      ><span class="hs-identifier hs-var"
+	>b</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+</span
+      ></pre
+    ></body
+  ></html
+>
diff --git a/hypsrc-test/ref/src/Records.html b/hypsrc-test/ref/src/Records.html
new file mode 100644
index 0000000000..b982c5b1c8
--- /dev/null
+++ b/hypsrc-test/ref/src/Records.html
@@ -0,0 +1,646 @@
+<!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
+  ><link rel="stylesheet" type="text/css" href="style.css"
+     /><script type="text/javascript" src="highlight.js"
+    ></script
+    ></head
+  ><body
+  ><pre
+    ><span class="hs-pragma"
+      >{-# LANGUAGE NamedFieldPuns #-}</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-keyword"
+      >module</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >Records</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-keyword"
+      >data</span
+      ><span class=""
+      > </span
+      ><a name="Point"
+      ><a href="Records.html#Point"
+	><span class="hs-identifier"
+	  >Point</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a name="Point"
+      ><a href="Records.html#Point"
+	><span class="hs-identifier"
+	  >Point</span
+	  ></a
+	></a
+      ><span class=""
+      >
+    </span
+      ><span class="hs-special"
+      >{</span
+      ><span class=""
+      > </span
+      ><a name="x"
+      ><a href="Records.html#x"
+	><span class="hs-identifier"
+	  >x</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >!</span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+    </span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a name="y"
+      ><a href="Records.html#y"
+	><span class="hs-identifier"
+	  >y</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >!</span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+    </span
+      ><span class="hs-special"
+      >}</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-identifier"
+      >point</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#Point"
+      ><span class="hs-identifier hs-type"
+	>Point</span
+	></a
+      ><span class=""
+      >
+</span
+      ><a name="point"
+      ><a href="Records.html#point"
+	><span class="hs-identifier"
+	  >point</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391304"
+      ><a href="#local-1627391304"
+	><span class="hs-identifier"
+	  >x</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391305"
+      ><a href="#local-1627391305"
+	><span class="hs-identifier"
+	  >y</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#Point"
+      ><span class="hs-identifier hs-var"
+	>Point</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >{</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#x"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391304"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#y"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391305"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >}</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-identifier"
+      >lengthSqr</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#Point"
+      ><span class="hs-identifier hs-type"
+	>Point</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+</span
+      ><a name="lengthSqr"
+      ><a href="Records.html#lengthSqr"
+	><span class="hs-identifier"
+	  >lengthSqr</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Records.html#Point"
+      ><span class="hs-identifier hs-var"
+	>Point</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >{</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#x"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a name="local-1627391306"
+      ><a href="#local-1627391306"
+	><span class="hs-identifier"
+	  >x</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#y"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a name="local-1627391307"
+      ><a href="#local-1627391307"
+	><span class="hs-identifier"
+	  >y</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >}</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391306"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391306"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391307"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391307"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-identifier"
+      >lengthSqr'</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#Point"
+      ><span class="hs-identifier hs-type"
+	>Point</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+</span
+      ><a name="lengthSqr%27"
+      ><a href="Records.html#lengthSqr%27"
+	><span class="hs-identifier"
+	  >lengthSqr'</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Records.html#Point"
+      ><span class="hs-identifier hs-var"
+	>Point</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >{</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#x"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#y"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >}</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391369"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391369"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391368"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391368"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-identifier"
+      >translateX</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >translateY</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#Point"
+      ><span class="hs-identifier hs-type"
+	>Point</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#Point"
+      ><span class="hs-identifier hs-type"
+	>Point</span
+	></a
+      ><span class=""
+      >
+</span
+      ><a name="translateX"
+      ><a href="Records.html#translateX"
+	><span class="hs-identifier"
+	  >translateX</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391370"
+      ><a href="#local-1627391370"
+	><span class="hs-identifier"
+	  >p</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391371"
+      ><a href="#local-1627391371"
+	><span class="hs-identifier"
+	  >d</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391370"
+      ><span class="hs-identifier hs-var"
+	>p</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >{</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#x"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#x"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627391370"
+      ><span class="hs-identifier hs-var"
+	>p</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391371"
+      ><span class="hs-identifier hs-var"
+	>d</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >}</span
+      ><span class=""
+      >
+</span
+      ><a name="translateY"
+      ><a href="Records.html#translateY"
+	><span class="hs-identifier"
+	  >translateY</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391372"
+      ><a href="#local-1627391372"
+	><span class="hs-identifier"
+	  >p</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-1627391373"
+      ><a href="#local-1627391373"
+	><span class="hs-identifier"
+	  >d</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391372"
+      ><span class="hs-identifier hs-var"
+	>p</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >{</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#y"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#y"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-1627391372"
+      ><span class="hs-identifier hs-var"
+	>p</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><a href="#local-1627391373"
+      ><span class="hs-identifier hs-var"
+	>d</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >}</span
+      ><span class=""
+      >
+</span
+      ></pre
+    ></body
+  ></html
+>

From 395a9c3941f8b8891cffa5c17e1f6ae414edaa79 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 00:47:32 +0200
Subject: [PATCH 074/109] Make hyperlinker test runner strip local links from
 generated source.

---
 hypsrc-test/Utils.hs | 26 ++++++++++++++++++++++++++
 hypsrc-test/run.hs   | 37 +++++++++++++++++++++++++++----------
 2 files changed, 53 insertions(+), 10 deletions(-)
 create mode 100644 hypsrc-test/Utils.hs

diff --git a/hypsrc-test/Utils.hs b/hypsrc-test/Utils.hs
new file mode 100644
index 0000000000..cf3e94ea11
--- /dev/null
+++ b/hypsrc-test/Utils.hs
@@ -0,0 +1,26 @@
+module Utils
+    ( stripLocalAnchors
+    , stripLocalLinks
+    , stripLocalReferences
+    ) where
+
+
+import Data.List
+
+
+replaceBetween :: Eq a => [a] -> a -> [a] -> [a] -> [a]
+replaceBetween _ _ _ [] = []
+replaceBetween pref end val html@(x:xs') = case stripPrefix pref html of
+    Just strip -> pref ++ val ++ (replaceBetween' . dropWhile (/= end)) strip
+    Nothing -> x:(replaceBetween' xs')
+  where
+    replaceBetween' = replaceBetween pref end val
+
+stripLocalAnchors :: String -> String
+stripLocalAnchors = replaceBetween "<a name=\"local-" '\"' "0"
+
+stripLocalLinks :: String -> String
+stripLocalLinks = replaceBetween "<a href=\"#local-" '\"' "0"
+
+stripLocalReferences :: String -> String
+stripLocalReferences = stripLocalLinks . stripLocalAnchors
diff --git a/hypsrc-test/run.hs b/hypsrc-test/run.hs
index e9a38c0c05..5b6b6548f2 100755
--- a/hypsrc-test/run.hs
+++ b/hypsrc-test/run.hs
@@ -18,6 +18,8 @@ import System.Process
 import Distribution.Verbosity
 import Distribution.Simple.Utils hiding (die)
 
+import Utils
+
 
 baseDir, rootDir :: FilePath
 baseDir = takeDirectory __FILE__
@@ -64,14 +66,9 @@ check strict mdl = do
     hasReference <- doesFileExist refFile
     if hasReference
     then do
-        out <- readFile outFile
         ref <- readFile refFile
-        if out == ref
-        then putStrLn $ "Pass: " ++ mdl
-        else do
-            putStrLn $ "Fail: " ++ mdl
-            diff refFile outFile
-            when strict $ die "Aborting further tests."
+        out <- readFile outFile
+        compareOutput strict mdl ref out
     else do
         putStrLn $ "Pass: " ++ mdl ++ " (no reference file)"
   where
@@ -79,13 +76,33 @@ check strict mdl = do
     outFile = outDir' </> takeBaseName mdl ++ ".html"
 
 
-diff :: FilePath -> FilePath -> IO ()
-diff fileA fileB = do
+compareOutput :: Bool -> FilePath -> String -> String -> IO ()
+compareOutput strict mdl ref out = do
+    if ref' == out'
+    then putStrLn $ "Pass: " ++ mdl
+    else do
+        putStrLn $ "Fail: " ++ mdl
+        diff mdl ref' out'
+        when strict $ die "Aborting further tests."
+  where
+    ref' = stripLocalReferences ref
+    out' = stripLocalReferences out
+
+
+diff :: FilePath -> String -> String -> IO ()
+diff mdl ref out = do
     colorDiffPath <- findProgramLocation silent "colordiff"
     let cmd = fromMaybe "diff" colorDiffPath
 
-    result <- system $ cmd ++ " " ++ fileA ++ " " ++ fileB
+    writeFile refFile ref
+    writeFile outFile out
+
+    result <- system $ cmd ++ " " ++ refFile ++ " " ++ outFile
     unless (result == ExitSuccess) $ die "Failed to run `diff` command."
+  where
+    refFile = outDir </> takeFileName mdl </> ".ref.nolinks"
+    outFile = outDir </> takeFileName mdl </> ".nolinks"
+
 
 
 getAllSrcModules :: IO [FilePath]

From 767569881732c59378fb577d1a2b57b51bc454d0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 01:14:59 +0200
Subject: [PATCH 075/109] Create simple script for accepting hyperlinker test
 case references.

---
 haddock.cabal         |  1 +
 hypsrc-test/Utils.hs  | 27 ++++++++++++++++++++++++---
 hypsrc-test/accept.hs | 27 +++++++++++++++++++++++++++
 hypsrc-test/run.hs    | 25 ++++---------------------
 4 files changed, 56 insertions(+), 24 deletions(-)
 create mode 100755 hypsrc-test/accept.hs

diff --git a/haddock.cabal b/haddock.cabal
index 01e6a55879..2a1caee7b1 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -128,6 +128,7 @@ test-suite hypsrc-test
   main-is:          run.hs
   hs-source-dirs:   hypsrc-test
   build-depends:    base, directory, process, filepath, Cabal
+  ghc-options:      -Wall -fwarn-tabs
 
 test-suite latex-test
   type:             exitcode-stdio-1.0
diff --git a/hypsrc-test/Utils.hs b/hypsrc-test/Utils.hs
index cf3e94ea11..e15fabee86 100644
--- a/hypsrc-test/Utils.hs
+++ b/hypsrc-test/Utils.hs
@@ -1,12 +1,33 @@
+{-# LANGUAGE CPP #-}
+
+
 module Utils
-    ( stripLocalAnchors
-    , stripLocalLinks
-    , stripLocalReferences
+    ( baseDir, rootDir
+    , srcDir, refDir, outDir, refDir', outDir'
+    , haddockPath
+    , stripLocalAnchors, stripLocalLinks, stripLocalReferences
     ) where
 
 
 import Data.List
 
+import System.FilePath
+
+
+baseDir, rootDir :: FilePath
+baseDir = takeDirectory __FILE__
+rootDir = baseDir </> ".."
+
+srcDir, refDir, outDir, refDir', outDir' :: FilePath
+srcDir = baseDir </> "src"
+refDir = baseDir </> "ref"
+outDir = baseDir </> "out"
+refDir' = refDir </> "src"
+outDir' = outDir </> "src"
+
+haddockPath :: FilePath
+haddockPath = rootDir </> "dist" </> "build" </> "haddock" </> "haddock"
+
 
 replaceBetween :: Eq a => [a] -> a -> [a] -> [a] -> [a]
 replaceBetween _ _ _ [] = []
diff --git a/hypsrc-test/accept.hs b/hypsrc-test/accept.hs
new file mode 100755
index 0000000000..4606b2dfb0
--- /dev/null
+++ b/hypsrc-test/accept.hs
@@ -0,0 +1,27 @@
+#!/usr/bin/env runhaskell
+{-# LANGUAGE CPP #-}
+
+
+import System.Directory
+import System.FilePath
+import System.Environment
+
+import Utils
+
+
+main :: IO ()
+main = do
+    args <- getArgs
+    files <- filter isHtmlFile <$> getDirectoryContents outDir'
+    let files' = if args == ["--all"] || args == ["-a"]
+        then files
+        else filter ((`elem` args) . takeBaseName) files
+    mapM_ copy files'
+  where
+    isHtmlFile = (== ".html") . takeExtension
+
+
+copy :: FilePath -> IO ()
+copy file = do
+    content <- stripLocalReferences <$> readFile (outDir' </> file)
+    writeFile (refDir' </> file) content
diff --git a/hypsrc-test/run.hs b/hypsrc-test/run.hs
index 5b6b6548f2..10b6c257c3 100755
--- a/hypsrc-test/run.hs
+++ b/hypsrc-test/run.hs
@@ -2,13 +2,11 @@
 {-# LANGUAGE CPP #-}
 
 
-import Control.Applicative
 import Control.Monad
 
 import Data.List
 import Data.Maybe
 
-import System.IO
 import System.Directory
 import System.Environment
 import System.Exit
@@ -21,21 +19,6 @@ import Distribution.Simple.Utils hiding (die)
 import Utils
 
 
-baseDir, rootDir :: FilePath
-baseDir = takeDirectory __FILE__
-rootDir = baseDir </> ".."
-
-srcDir, refDir, outDir, refDir', outDir' :: FilePath
-srcDir = baseDir </> "src"
-refDir = baseDir </> "ref"
-outDir = baseDir </> "out"
-refDir' = refDir </> "src"
-outDir' = outDir </> "src"
-
-haddockPath :: FilePath
-haddockPath = rootDir </> "dist" </> "build" </> "haddock" </> "haddock"
-
-
 main :: IO ()
 main = do
     haddockAvailable <- doesFileExist haddockPath
@@ -107,9 +90,9 @@ diff mdl ref out = do
 
 getAllSrcModules :: IO [FilePath]
 getAllSrcModules =
-    filter isValid <$> getDirectoryContents srcDir
+    filter isHaskellFile <$> getDirectoryContents srcDir
   where
-    isValid = (== ".hs") . takeExtension
+    isHaskellFile = (== ".hs") . takeExtension
 
 
 putHaddockVersion :: IO ()
@@ -128,8 +111,8 @@ putGhcVersion = do
 
 runHaddock :: [String] -> IO ()
 runHaddock args = do
-    env <- Just <$> getEnvironment
-    handle <- runProcess haddockPath args Nothing env Nothing Nothing Nothing
+    menv <- Just <$> getEnvironment
+    handle <- runProcess haddockPath args Nothing menv Nothing Nothing Nothing
     waitForSuccess handle $ "Failed to invoke haddock with " ++ show args
 
 

From db51ad0a5b2b29749f69fd82513adeedc8729735 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 01:16:41 +0200
Subject: [PATCH 076/109] Re-accept hyperlinker test cases with local
 references stripped out.

---
 hypsrc-test/ref/src/Constructors.html |  24 +++---
 hypsrc-test/ref/src/Identifiers.html  | 118 +++++++++++++-------------
 hypsrc-test/ref/src/Literals.html     |  10 +--
 hypsrc-test/ref/src/Operators.html    | 104 +++++++++++------------
 hypsrc-test/ref/src/Records.html      |  64 +++++++-------
 5 files changed, 160 insertions(+), 160 deletions(-)

diff --git a/hypsrc-test/ref/src/Constructors.html b/hypsrc-test/ref/src/Constructors.html
index 713a85f00e..6d6c7c06ac 100644
--- a/hypsrc-test/ref/src/Constructors.html
+++ b/hypsrc-test/ref/src/Constructors.html
@@ -315,16 +315,16 @@
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627396015"
-      ><a href="#local-1627396015"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >foo</span
 	  ></a
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627396016"
-      ><a href="#local-1627396016"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >n</span
 	  ></a
@@ -345,7 +345,7 @@
       >*</span
       ><span class=""
       > </span
-      ><a href="#local-1627396016"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>n</span
 	></a
@@ -361,7 +361,7 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627396015"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>foo</span
 	></a
@@ -425,8 +425,8 @@
       >,</span
       ><span class=""
       > </span
-      ><a name="local-1627396017"
-      ><a href="#local-1627396017"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >xs</span
 	  ></a
@@ -449,7 +449,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627396017"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>xs</span
 	></a
@@ -478,8 +478,8 @@
       >,</span
       ><span class=""
       > </span
-      ><a name="local-1627396018"
-      ><a href="#local-1627396018"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >xs</span
 	  ></a
@@ -506,7 +506,7 @@
       >reverse</span
       ><span class=""
       > </span
-      ><a href="#local-1627396018"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>xs</span
 	></a
diff --git a/hypsrc-test/ref/src/Identifiers.html b/hypsrc-test/ref/src/Identifiers.html
index ee21791fe3..4c82ad018d 100644
--- a/hypsrc-test/ref/src/Identifiers.html
+++ b/hypsrc-test/ref/src/Identifiers.html
@@ -71,16 +71,16 @@
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391970"
-      ><a href="#local-1627391970"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >x</span
 	  ></a
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391971"
-      ><a href="#local-1627391971"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >y</span
 	  ></a
@@ -91,7 +91,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627391970"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -101,7 +101,7 @@
       >+</span
       ><span class=""
       > </span
-      ><a href="#local-1627391970"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -117,13 +117,13 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627391971"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627391970"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -133,7 +133,7 @@
       >*</span
       ><span class=""
       > </span
-      ><a href="#local-1627391971"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -143,7 +143,7 @@
       >+</span
       ><span class=""
       > </span
-      ><a href="#local-1627391971"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -158,16 +158,16 @@
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391972"
-      ><a href="#local-1627391972"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >x</span
 	  ></a
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391973"
-      ><a href="#local-1627391973"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >y</span
 	  ></a
@@ -178,7 +178,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627391973"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -188,7 +188,7 @@
       >+</span
       ><span class=""
       > </span
-      ><a href="#local-1627391972"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -204,13 +204,13 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627391972"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627391973"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -220,7 +220,7 @@
       >-</span
       ><span class=""
       > </span
-      ><a href="#local-1627391972"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -230,7 +230,7 @@
       >+</span
       ><span class=""
       > </span
-      ><a href="#local-1627391973"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -245,16 +245,16 @@
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391974"
-      ><a href="#local-1627391974"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >x</span
 	  ></a
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391975"
-      ><a href="#local-1627391975"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >y</span
 	  ></a
@@ -265,7 +265,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627391974"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -275,7 +275,7 @@
       >*</span
       ><span class=""
       > </span
-      ><a href="#local-1627391975"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -285,7 +285,7 @@
       >*</span
       ><span class=""
       > </span
-      ><a href="#local-1627391975"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -295,7 +295,7 @@
       >*</span
       ><span class=""
       > </span
-      ><a href="#local-1627391975"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -305,7 +305,7 @@
       >*</span
       ><span class=""
       > </span
-      ><a href="#local-1627391974"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -342,8 +342,8 @@
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391976"
-      ><a href="#local-1627391976"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >x</span
 	  ></a
@@ -368,13 +368,13 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627391976"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627391976"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -390,13 +390,13 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627391976"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627391976"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -451,24 +451,24 @@
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391977"
-      ><a href="#local-1627391977"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >x</span
 	  ></a
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391978"
-      ><a href="#local-1627391978"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >y</span
 	  ></a
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391979"
-      ><a href="#local-1627391979"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >z</span
 	  ></a
@@ -480,7 +480,7 @@
       >|</span
       ><span class=""
       > </span
-      ><a href="#local-1627391977"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -504,7 +504,7 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627391977"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -515,7 +515,7 @@
       >|</span
       ><span class=""
       > </span
-      ><a href="#local-1627391978"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -539,7 +539,7 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627391978"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -550,7 +550,7 @@
       >|</span
       ><span class=""
       > </span
-      ><a href="#local-1627391979"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>z</span
 	></a
@@ -574,7 +574,7 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627391979"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>z</span
 	></a
@@ -603,7 +603,7 @@
       >(</span
       ><span class="hs-glyph"
       >-</span
-      ><a href="#local-1627391977"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -615,7 +615,7 @@
       >(</span
       ><span class="hs-glyph"
       >-</span
-      ><a href="#local-1627391978"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -627,7 +627,7 @@
       >(</span
       ><span class="hs-glyph"
       >-</span
-      ><a href="#local-1627391979"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>z</span
 	></a
@@ -696,13 +696,13 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627392781"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627392782"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -731,7 +731,7 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627392783"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>z</span
 	></a
@@ -743,8 +743,8 @@
       ><span class=""
       >
     </span
-      ><a name="local-1627392781"
-      ><a href="#local-1627392781"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >x</span
 	  ></a
@@ -760,8 +760,8 @@
       ><span class=""
       >
     </span
-      ><a name="local-1627392782"
-      ><a href="#local-1627392782"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >y</span
 	  ></a
@@ -777,8 +777,8 @@
       ><span class=""
       >
     </span
-      ><a name="local-1627392783"
-      ><a href="#local-1627392783"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >z</span
 	  ></a
diff --git a/hypsrc-test/ref/src/Literals.html b/hypsrc-test/ref/src/Literals.html
index f854964288..f2e4749b4f 100644
--- a/hypsrc-test/ref/src/Literals.html
+++ b/hypsrc-test/ref/src/Literals.html
@@ -65,7 +65,7 @@
       >Num</span
       ><span class=""
       > </span
-      ><a href="#local-1627395902"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -75,7 +75,7 @@
       >=&gt;</span
       ><span class=""
       > </span
-      ><a href="#local-1627395902"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -144,7 +144,7 @@
       >Fractional</span
       ><span class=""
       > </span
-      ><a href="#local-1627395418"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -154,7 +154,7 @@
       >=&gt;</span
       ><span class=""
       > </span
-      ><a href="#local-1627395418"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -195,7 +195,7 @@
       >[</span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627395417"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
diff --git a/hypsrc-test/ref/src/Operators.html b/hypsrc-test/ref/src/Operators.html
index 04fe4ee45c..9ed24ab9c3 100644
--- a/hypsrc-test/ref/src/Operators.html
+++ b/hypsrc-test/ref/src/Operators.html
@@ -36,7 +36,7 @@
       > </span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393973"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -50,7 +50,7 @@
       > </span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393973"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -64,7 +64,7 @@
       > </span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393973"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -73,8 +73,8 @@
       ><span class=""
       >
 </span
-      ><a name="local-1627393974"
-      ><a href="#local-1627393974"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >a</span
 	  ></a
@@ -89,8 +89,8 @@
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627393975"
-      ><a href="#local-1627393975"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >b</span
 	  ></a
@@ -101,7 +101,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627393974"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>a</span
 	></a
@@ -111,7 +111,7 @@
       >++</span
       ><span class=""
       > </span
-      ><a href="#local-1627393975"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>b</span
 	></a
@@ -121,7 +121,7 @@
       >++</span
       ><span class=""
       > </span
-      ><a href="#local-1627393974"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>a</span
 	></a
@@ -143,7 +143,7 @@
       > </span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393972"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -157,7 +157,7 @@
       > </span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393972"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -171,7 +171,7 @@
       > </span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393972"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -180,8 +180,8 @@
       ><span class=""
       >
 </span
-      ><a name="local-1627393976"
-      ><a href="#local-1627393976"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >a</span
 	  ></a
@@ -196,8 +196,8 @@
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627393977"
-      ><a href="#local-1627393977"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >b</span
 	  ></a
@@ -208,7 +208,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627393977"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>b</span
 	></a
@@ -220,7 +220,7 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627393976"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>a</span
 	></a
@@ -242,7 +242,7 @@
       > </span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393971"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -256,7 +256,7 @@
       > </span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393971"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -270,7 +270,7 @@
       > </span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393971"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -291,8 +291,8 @@
       >)</span
       ><span class=""
       > </span
-      ><a name="local-1627393978"
-      ><a href="#local-1627393978"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >a</span
 	  ></a
@@ -309,7 +309,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627393978"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>a</span
 	></a
@@ -324,8 +324,8 @@
       >)</span
       ><span class=""
       > </span
-      ><a name="local-1627393979"
-      ><a href="#local-1627393979"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >a</span
 	  ></a
@@ -338,8 +338,8 @@
       >_</span
       ><span class="hs-glyph"
       >:</span
-      ><a name="local-1627393980"
-      ><a href="#local-1627393980"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >b</span
 	  ></a
@@ -352,7 +352,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627393979"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>a</span
 	></a
@@ -366,7 +366,7 @@
       > </span
       ><span class="hs-special"
       >(</span
-      ><a href="#local-1627393979"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>a</span
 	></a
@@ -378,7 +378,7 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627393980"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>b</span
 	></a
@@ -404,7 +404,7 @@
       >[</span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393970"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -420,7 +420,7 @@
       > </span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393970"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -434,7 +434,7 @@
       > </span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393970"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -443,8 +443,8 @@
       ><span class=""
       >
 </span
-      ><a name="local-1627393981"
-      ><a href="#local-1627393981"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >a</span
 	  ></a
@@ -459,8 +459,8 @@
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627393982"
-      ><a href="#local-1627393982"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >b</span
 	  ></a
@@ -483,7 +483,7 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627393982"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>b</span
 	></a
@@ -491,7 +491,7 @@
       >)</span
       ><span class=""
       > </span
-      ><a href="#local-1627393981"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>a</span
 	></a
@@ -515,7 +515,7 @@
       >[</span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393969"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -533,7 +533,7 @@
       >[</span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393969"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -551,7 +551,7 @@
       >[</span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627393969"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-type"
 	>a</span
 	></a
@@ -562,8 +562,8 @@
       ><span class=""
       >
 </span
-      ><a name="local-1627394362"
-      ><a href="#local-1627394362"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >a</span
 	  ></a
@@ -578,8 +578,8 @@
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627394363"
-      ><a href="#local-1627394363"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >b</span
 	  ></a
@@ -606,7 +606,7 @@
       > </span
       ><span class="hs-special"
       >[</span
-      ><a href="#local-1627394362"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>a</span
 	></a
@@ -618,7 +618,7 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627394363"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>b</span
 	></a
@@ -628,7 +628,7 @@
       > </span
       ><span class="hs-special"
       >(</span
-      ><a href="#local-1627394362"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>a</span
 	></a
@@ -640,7 +640,7 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627394363"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>b</span
 	></a
diff --git a/hypsrc-test/ref/src/Records.html b/hypsrc-test/ref/src/Records.html
index b982c5b1c8..cdff7eb5ef 100644
--- a/hypsrc-test/ref/src/Records.html
+++ b/hypsrc-test/ref/src/Records.html
@@ -145,16 +145,16 @@
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391304"
-      ><a href="#local-1627391304"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >x</span
 	  ></a
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391305"
-      ><a href="#local-1627391305"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >y</span
 	  ></a
@@ -185,7 +185,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627391304"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -203,7 +203,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627391305"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -269,8 +269,8 @@
       >=</span
       ><span class=""
       > </span
-      ><a name="local-1627391306"
-      ><a href="#local-1627391306"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >x</span
 	  ></a
@@ -289,8 +289,8 @@
       >=</span
       ><span class=""
       > </span
-      ><a name="local-1627391307"
-      ><a href="#local-1627391307"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >y</span
 	  ></a
@@ -307,7 +307,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627391306"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -317,7 +317,7 @@
       >*</span
       ><span class=""
       > </span
-      ><a href="#local-1627391306"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -327,7 +327,7 @@
       >+</span
       ><span class=""
       > </span
-      ><a href="#local-1627391307"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -337,7 +337,7 @@
       >*</span
       ><span class=""
       > </span
-      ><a href="#local-1627391307"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -412,7 +412,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627391369"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -422,7 +422,7 @@
       >*</span
       ><span class=""
       > </span
-      ><a href="#local-1627391369"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>y</span
 	></a
@@ -432,7 +432,7 @@
       >+</span
       ><span class=""
       > </span
-      ><a href="#local-1627391368"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -442,7 +442,7 @@
       >*</span
       ><span class=""
       > </span
-      ><a href="#local-1627391368"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>x</span
 	></a
@@ -498,16 +498,16 @@
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391370"
-      ><a href="#local-1627391370"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >p</span
 	  ></a
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391371"
-      ><a href="#local-1627391371"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >d</span
 	  ></a
@@ -518,7 +518,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627391370"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>p</span
 	></a
@@ -544,7 +544,7 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627391370"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>p</span
 	></a
@@ -554,7 +554,7 @@
       >+</span
       ><span class=""
       > </span
-      ><a href="#local-1627391371"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>d</span
 	></a
@@ -573,16 +573,16 @@
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391372"
-      ><a href="#local-1627391372"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >p</span
 	  ></a
 	></a
       ><span class=""
       > </span
-      ><a name="local-1627391373"
-      ><a href="#local-1627391373"
+      ><a name="local-0"
+      ><a href="#local-0"
 	><span class="hs-identifier"
 	  >d</span
 	  ></a
@@ -593,7 +593,7 @@
       >=</span
       ><span class=""
       > </span
-      ><a href="#local-1627391372"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>p</span
 	></a
@@ -619,7 +619,7 @@
 	></a
       ><span class=""
       > </span
-      ><a href="#local-1627391372"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>p</span
 	></a
@@ -629,7 +629,7 @@
       >+</span
       ><span class=""
       > </span
-      ><a href="#local-1627391373"
+      ><a href="#local-0"
       ><span class="hs-identifier hs-var"
 	>d</span
 	></a

From a229331e45518bc7102acc6b19fc492c85321c4f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 01:22:09 +0200
Subject: [PATCH 077/109] Fix bug with diffing wrong files in hyperlinker test
 runner.

---
 hypsrc-test/run.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/hypsrc-test/run.hs b/hypsrc-test/run.hs
index 10b6c257c3..853c4f091e 100755
--- a/hypsrc-test/run.hs
+++ b/hypsrc-test/run.hs
@@ -83,8 +83,8 @@ diff mdl ref out = do
     result <- system $ cmd ++ " " ++ refFile ++ " " ++ outFile
     unless (result == ExitSuccess) $ die "Failed to run `diff` command."
   where
-    refFile = outDir </> takeFileName mdl </> ".ref.nolinks"
-    outFile = outDir </> takeFileName mdl </> ".nolinks"
+    refFile = outDir </> takeBaseName mdl ++ ".ref.nolinks"
+    outFile = outDir </> takeBaseName mdl ++ ".nolinks"
 
 
 

From 4b0b4a834b7eeeb0c688ab8718bc9720c00ee67c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 18:04:46 +0200
Subject: [PATCH 078/109] Remove unused dependencies in Haddock API spec
 configuration.

---
 haddock-api/haddock-api.cabal | 11 -----------
 1 file changed, 11 deletions(-)

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 56889e664b..11567f99b6 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -111,18 +111,7 @@ test-suite spec
 
   build-depends:
       base >= 4.3 && < 4.9
-    , bytestring
-    , filepath
-    , directory
     , containers
-    , deepseq
-    , array
-    , xhtml >= 3000.2 && < 3000.3
-    , Cabal >= 1.10
-    , ghc >= 7.10 && < 7.10.2
-
-    , ghc-paths
-    , haddock-library == 1.2.*
 
     , hspec
     , QuickCheck == 2.*

From b91ee2f4f0869d1c1076813019ce858c53738042 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 18:32:19 +0200
Subject: [PATCH 079/109] Add support for hyperlinking synonyms in patterns.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index c41b5e5fe9..8777e26dbd 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -110,6 +110,8 @@ binds =
             pure (sspan, RtkBind name)
         (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) recs))) ->
             [(sspan, RtkVar name)] ++ everything (<|>) rec recs
+        (Just (GHC.L _ (GHC.AsPat (GHC.L sspan name) _))) ->
+            pure (sspan, RtkBind name)
         _ -> empty
     rec term = case cast term of
         (Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LPat GHC.Name) _)) ->

From dc2eed5daa4d01f97a4686352fd17405f4567169 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 18:33:44 +0200
Subject: [PATCH 080/109] Create test case for hyperlinking @-patterns.

---
 hypsrc-test/ref/src/Constructors.html | 298 ++++++++++++++++++++++++++
 hypsrc-test/src/Constructors.hs       |   8 +
 2 files changed, 306 insertions(+)

diff --git a/hypsrc-test/ref/src/Constructors.html b/hypsrc-test/ref/src/Constructors.html
index 6d6c7c06ac..96be3627f1 100644
--- a/hypsrc-test/ref/src/Constructors.html
+++ b/hypsrc-test/ref/src/Constructors.html
@@ -529,6 +529,304 @@
       >undefined</span
       ><span class=""
       >
+
+
+</span
+      ><span class="hs-identifier"
+      >unnorf'</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#Norf"
+      ><span class="hs-identifier hs-type"
+	>Norf</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+</span
+      ><a name="unnorf%27"
+      ><a href="Constructors.html#unnorf%27"
+	><span class="hs-identifier"
+	  >unnorf'</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >x</span
+	  ></a
+	></a
+      ><span class="hs-glyph"
+      >@</span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Constructors.html#Norf"
+      ><span class="hs-identifier hs-var"
+	>Norf</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >f1</span
+	  ></a
+	></a
+      ><span class="hs-glyph"
+      >@</span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Constructors.html#Quux"
+      ><span class="hs-identifier hs-var"
+	>Quux</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >_</span
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >n</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >_</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >f2</span
+	  ></a
+	></a
+      ><span class="hs-glyph"
+      >@</span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Constructors.html#Quux"
+      ><span class="hs-identifier hs-var"
+	>Quux</span
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >f3</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >_</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      >
+    </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>x'</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>n</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#unfoo"
+      ><span class="hs-identifier hs-var"
+	>unfoo</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>f1</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>aux</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>f3</span
+	></a
+      ><span class=""
+      >
+  </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+    </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >aux</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >fx</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#unfoo"
+      ><span class="hs-identifier hs-var"
+	>unfoo</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>f2</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#unfoo"
+      ><span class="hs-identifier hs-var"
+	>unfoo</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>fx</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >*</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#unfoo"
+      ><span class="hs-identifier hs-var"
+	>unfoo</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>f3</span
+	></a
+      ><span class=""
+      >
+    </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >x'</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >sum</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >.</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >map</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#unfoo"
+      ><span class="hs-identifier hs-var"
+	>unfoo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >.</span
+      ><span class=""
+      > </span
+      ><a href="Constructors.html#unnorf"
+      ><span class="hs-identifier hs-var"
+	>unnorf</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >$</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      >
 </span
       ></pre
     ></body
diff --git a/hypsrc-test/src/Constructors.hs b/hypsrc-test/src/Constructors.hs
index c52bdc723a..8cb465359b 100644
--- a/hypsrc-test/src/Constructors.hs
+++ b/hypsrc-test/src/Constructors.hs
@@ -25,3 +25,11 @@ unnorf :: Norf -> [Foo]
 unnorf (Norf (Bar, xs, Bar)) = xs
 unnorf (Norf (Baz, xs, Baz)) = reverse xs
 unnorf _ = undefined
+
+
+unnorf' :: Norf -> Int
+unnorf' x@(Norf (f1@(Quux _ n), _, f2@(Quux f3 _))) =
+    x' + n * unfoo f1 + aux f3
+  where
+    aux fx = unfoo f2 * unfoo fx * unfoo f3
+    x' = sum . map unfoo . unnorf $ x

From dd781d18eca0d8c28350093d78926d4a9b474827 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 19:06:04 +0200
Subject: [PATCH 081/109] Add support for hyperlinking universally quantified
 type variables.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 8777e26dbd..79e31db703 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -99,7 +99,7 @@ types =
 -- clauses).
 binds :: GHC.RenamedSource -> DetailsMap
 binds =
-    everything (<|>) (fun `combine` pat)
+    everything (<|>) (fun `combine` pat `combine` tvar)
   where
     fun term = case cast term of
         (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name)) ->
@@ -117,6 +117,12 @@ binds =
         (Just (GHC.HsRecField (GHC.L sspan name) (_ :: GHC.LPat GHC.Name) _)) ->
             pure (sspan, RtkVar name)
         _ -> empty
+    tvar term = case cast term of
+        (Just (GHC.L sspan (GHC.UserTyVar name))) ->
+            pure (sspan, RtkBind name)
+        (Just (GHC.L _ (GHC.KindedTyVar (GHC.L sspan name) _))) ->
+            pure (sspan, RtkBind name)
+        _ -> empty
 
 -- | Obtain details map for top-level declarations.
 decls :: GHC.RenamedSource -> DetailsMap

From 571944f4a81feae7e04b05d1549a19e0b677f4eb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 19:28:32 +0200
Subject: [PATCH 082/109] Create hyperlinker test case with quantified type
 variables.

---
 hypsrc-test/src/Polymorphism.hs | 55 +++++++++++++++++++++++++++++++++
 1 file changed, 55 insertions(+)
 create mode 100644 hypsrc-test/src/Polymorphism.hs

diff --git a/hypsrc-test/src/Polymorphism.hs b/hypsrc-test/src/Polymorphism.hs
new file mode 100644
index 0000000000..2e1a93bd98
--- /dev/null
+++ b/hypsrc-test/src/Polymorphism.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE RankNTypes #-}
+
+
+module Polymorphism where
+
+
+foo :: a -> a -> a
+foo = undefined
+
+foo' :: forall a. a -> a -> a
+foo' = undefined
+
+bar :: a -> b -> (a, b)
+bar = undefined
+
+bar' :: forall a b. a -> b -> (a, b)
+bar' = undefined
+
+baz :: a -> (a -> [a -> a] -> b) -> b
+baz = undefined
+
+baz' :: forall a b. a -> (a -> [a -> a] -> b) -> b
+baz' = undefined
+
+quux :: a -> (forall a. a -> a) -> a
+quux = undefined
+
+quux' :: forall a. a -> (forall a. a -> a) -> a
+quux' = undefined
+
+
+num :: Num a => a -> a -> a
+num = undefined
+
+num' :: forall a. Num a => a -> a -> a
+num' = undefined
+
+eq :: (Eq a, Eq b) => [a] -> [b] -> (a, b)
+eq = undefined
+
+eq' :: forall a b. (Eq a, Eq b) => [a] -> [b] -> (a, b)
+eq' = undefined
+
+mon :: Monad m => (a -> m a) -> m a
+mon = undefined
+
+mon' :: forall m a. Monad m => (a -> m a) -> m a
+mon' = undefined
+
+
+norf :: a -> (forall a. Ord a => a -> a) -> a
+norf = undefined
+
+norf' :: forall a. a -> (forall a. Ord a => a -> a) -> a
+norf' = undefined

From 2b748bb10a40d3787bea35fc24564edac64b11c9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 19:34:22 +0200
Subject: [PATCH 083/109] Add scoped type variables test for polymorphism test
 case.

---
 hypsrc-test/src/Polymorphism.hs | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/hypsrc-test/src/Polymorphism.hs b/hypsrc-test/src/Polymorphism.hs
index 2e1a93bd98..a74ac4921b 100644
--- a/hypsrc-test/src/Polymorphism.hs
+++ b/hypsrc-test/src/Polymorphism.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 
 module Polymorphism where
@@ -53,3 +54,13 @@ norf = undefined
 
 norf' :: forall a. a -> (forall a. Ord a => a -> a) -> a
 norf' = undefined
+
+
+plugh :: forall a. a -> a
+plugh x = x :: a
+
+thud :: forall a b. (a -> b) -> a -> (a, b)
+thud f x =
+    (x :: a, y) :: (a, b)
+  where
+    y = (f :: a -> b) x :: b

From d6fcd4692c1d77003ed83c9faf22a2d922dd761f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 19:56:27 +0200
Subject: [PATCH 084/109] Add record wildcards test for records hyperlinking
 test case.

---
 hypsrc-test/ref/src/Records.html | 241 +++++++++++++++++++++++++++++++
 hypsrc-test/src/Records.hs       |   9 ++
 2 files changed, 250 insertions(+)

diff --git a/hypsrc-test/ref/src/Records.html b/hypsrc-test/ref/src/Records.html
index cdff7eb5ef..0751782a2f 100644
--- a/hypsrc-test/ref/src/Records.html
+++ b/hypsrc-test/ref/src/Records.html
@@ -11,6 +11,12 @@
       >{-# LANGUAGE NamedFieldPuns #-}</span
       ><span class=""
       >
+</span
+      ><span class="hs-pragma"
+      >{-# LANGUAGE RecordWildCards #-}</span
+      ><span class=""
+      >
+
 
 </span
       ><span class="hs-keyword"
@@ -639,6 +645,241 @@
       >}</span
       ><span class=""
       >
+
+</span
+      ><span class="hs-identifier"
+      >translate</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#Point"
+      ><span class="hs-identifier hs-type"
+	>Point</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#Point"
+      ><span class="hs-identifier hs-type"
+	>Point</span
+	></a
+      ><span class=""
+      >
+</span
+      ><a name="translate"
+      ><a href="Records.html#translate"
+	><span class="hs-identifier"
+	  >translate</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >x</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >y</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >p</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      >
+    </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>aux</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>p</span
+	></a
+      ><span class=""
+      >
+  </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+    </span
+      ><span class="hs-special"
+      >(</span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >dx</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >dy</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+    </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >aux</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a href="Records.html#Point"
+      ><span class="hs-identifier hs-var"
+	>Point</span
+	></a
+      ><span class="hs-special"
+      >{</span
+      ><span class="hs-glyph"
+      >..</span
+      ><span class="hs-special"
+      >}</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>p</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >{</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#x"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>dx</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Records.html#y"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >+</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>dy</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >}</span
+      ><span class=""
+      >
 </span
       ></pre
     ></body
diff --git a/hypsrc-test/src/Records.hs b/hypsrc-test/src/Records.hs
index 4118e29698..40a01121f2 100644
--- a/hypsrc-test/src/Records.hs
+++ b/hypsrc-test/src/Records.hs
@@ -1,4 +1,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+
 
 module Records where
 
@@ -23,3 +25,10 @@ lengthSqr' (Point { x, y }) = y * y + x * x
 translateX, translateY :: Point -> Int -> Point
 translateX p d = p { x = x p + d }
 translateY p d = p { y = y p + d }
+
+translate :: Int -> Int -> Point -> Point
+translate x y p =
+    aux p
+  where
+    (dx, dy) = (x, y)
+    aux Point{..} = p { x = x + dx, y = y + dy }

From 980664b29a588eef44d8048d4beedce4d2a96b09 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 21:01:42 +0200
Subject: [PATCH 085/109] Document some functions in XHTML utlity module.

---
 haddock-api/src/Haddock/Backends/Xhtml/Utils.hs | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
index 36ecf86322..5166549ad1 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
@@ -41,11 +41,19 @@ import Module   ( Module, ModuleName, moduleName, moduleNameString )
 import Name     ( getOccString, nameOccName, isValOcc )
 
 
+-- | Replace placeholder string elements with provided values.
+--
+-- Used to generate URL for customized external paths, usually provided with
+-- @--source-module@, @--source-entity@ and related command-line arguments.
+--
+-- >>> spliceURL Nothing mmod mname Nothing "output/%{MODULE}.hs#%{NAME}"
+-- "output/Foo.hs#foo"
 spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name ->
              Maybe SrcSpan -> String -> String
 spliceURL mfile mmod = spliceURL' mfile (moduleName <$> mmod)
 
 
+-- | Same as 'spliceURL' but takes 'ModuleName' instead of 'Module'.
 spliceURL' :: Maybe FilePath -> Maybe ModuleName -> Maybe GHC.Name ->
               Maybe SrcSpan -> String -> String
 spliceURL' maybe_file maybe_mod maybe_name maybe_loc = run

From 868248d5e847e29ffede5b6c7d20f08a3ec7eb47 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 22:25:21 +0200
Subject: [PATCH 086/109] Make hyperlinker render qualified names as one
 entity.

---
 .../src/Haddock/Backends/Hyperlinker/Ast.hs   |  1 +
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 50 +++++++++++++++++--
 2 files changed, 46 insertions(+), 5 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 79e31db703..decb120654 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -25,6 +25,7 @@ data TokenDetails
     | RtkBind GHC.Name
     | RtkDecl GHC.Name
     | RtkModule GHC.ModuleName
+    deriving (Eq)
 
 rtkName :: TokenDetails -> Either GHC.Name GHC.ModuleName
 rtkName (RtkVar name) = Left name
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 89d9b60d14..ddb2e5b932 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -19,15 +19,46 @@ import qualified Data.Map as Map
 import Text.XHtml (Html, HtmlAttr, (!))
 import qualified Text.XHtml as Html
 
+
 type StyleClass = String
 
+
 render :: Maybe FilePath -> Maybe FilePath
        -> GHC.PackageKey -> SrcMap -> [RichToken]
        -> Html
 render mcss mjs pkg srcs tokens = header mcss mjs <> body pkg srcs tokens
 
+
+data TokenGroup
+    = GrpNormal Token
+    | GrpRich TokenDetails [Token]
+
+
+-- | Group consecutive tokens pointing to the same element.
+--
+-- We want to render qualified identifiers as one entity. For example,
+-- @Bar.Baz.foo@ consists of 5 tokens (@Bar@, @.@, @Baz@, @.@, @foo@) but for
+-- better user experience when highlighting and clicking links, these tokens
+-- should be regarded as one identifier. Therefore, before rendering we must
+-- group consecutive elements pointing to the same 'GHC.Name' (note that even
+-- dot token has it if it is part of qualified name).
+groupTokens :: [RichToken] -> [TokenGroup]
+groupTokens [] = []
+groupTokens ((RichToken tok Nothing):rest) = (GrpNormal tok):(groupTokens rest)
+groupTokens ((RichToken tok (Just det)):rest) =
+    let (grp, rest') = span same rest
+    in (GrpRich det (tok:(map rtkToken grp))):(groupTokens rest')
+  where
+    same (RichToken _ (Just det')) = det == det'
+    same _ = False
+
+
 body :: GHC.PackageKey -> SrcMap -> [RichToken] -> Html
-body pkg srcs = Html.body . Html.pre . mconcat . map (richToken pkg srcs)
+body pkg srcs tokens =
+    Html.body . Html.pre $ hypsrc
+  where
+    hypsrc = mconcat . map (tokenGroup pkg srcs) . groupTokens $ tokens
+
 
 header :: Maybe FilePath -> Maybe FilePath -> Html
 header mcss mjs
@@ -47,20 +78,29 @@ header mcss mjs =
         , Html.src scriptFile
         ]
 
-richToken :: GHC.PackageKey -> SrcMap -> RichToken -> Html
-richToken _ _ (RichToken tok Nothing) =
+
+tokenGroup :: GHC.PackageKey -> SrcMap -> TokenGroup -> Html
+tokenGroup _ _ (GrpNormal tok) =
     tokenSpan tok ! attrs
   where
     attrs = [ multiclass . tokenStyle . tkType $ tok ]
-richToken pkg srcs (RichToken tok (Just det)) =
+tokenGroup pkg srcs (GrpRich det tokens) =
     externalAnchor det . internalAnchor det . hyperlink pkg srcs det $ content
   where
-    content = tokenSpan tok ! [ multiclass style]
+    content = mconcat . map (richToken det) $ tokens
+
+
+richToken :: TokenDetails -> Token -> Html
+richToken det tok =
+    tokenSpan tok ! [ multiclass style ]
+  where
     style = (tokenStyle . tkType) tok ++ richTokenStyle det
 
+
 tokenSpan :: Token -> Html
 tokenSpan = Html.thespan . Html.toHtml . tkValue
 
+
 richTokenStyle :: TokenDetails -> [StyleClass]
 richTokenStyle (RtkVar _) = ["hs-var"]
 richTokenStyle (RtkType _) = ["hs-type"]

From 8071c27826d60eec1cb20f00f9767c32366defac Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Wed, 1 Jul 2015 22:27:38 +0200
Subject: [PATCH 087/109] Add qualified name test for identifiers hyperlinking
 test case.

---
 hypsrc-test/ref/src/Identifiers.html | 45 ++++++++++++++++++++++++++++
 hypsrc-test/src/Identifiers.hs       |  1 +
 2 files changed, 46 insertions(+)

diff --git a/hypsrc-test/ref/src/Identifiers.html b/hypsrc-test/ref/src/Identifiers.html
index 4c82ad018d..14cfbd8b8c 100644
--- a/hypsrc-test/ref/src/Identifiers.html
+++ b/hypsrc-test/ref/src/Identifiers.html
@@ -737,6 +737,51 @@
 	></a
       ><span class=""
       >
+    </span
+      ><span class="hs-identifier hs-var"
+      >putStrLn</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >.</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >show</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >$</span
+      ><span class=""
+      > </span
+      ><a href="Identifiers.html#norf"
+      ><span class="hs-identifier hs-var"
+	>Identifiers</span
+	><span class="hs-operator hs-var"
+	>.</span
+	><span class="hs-identifier hs-var"
+	>norf</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>z</span
+	></a
+      ><span class=""
+      >
   </span
       ><span class="hs-keyword"
       >where</span
diff --git a/hypsrc-test/src/Identifiers.hs b/hypsrc-test/src/Identifiers.hs
index e2d6223dcb..173c3ba7b3 100644
--- a/hypsrc-test/src/Identifiers.hs
+++ b/hypsrc-test/src/Identifiers.hs
@@ -21,6 +21,7 @@ main :: IO ()
 main = do
     putStrLn . show $ foo x y
     putStrLn . show $ quux z
+    putStrLn . show $ Identifiers.norf x y z
   where
     x = 10
     y = 20

From 0d0550cdcf3fa7ceff88e2572f7ffb341b9f760d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 2 Jul 2015 12:32:59 +0200
Subject: [PATCH 088/109] Fix crash happening when hyperlinking type family
 declarations.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index decb120654..c12ac35a22 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -135,6 +135,7 @@ decls (group, _, _, _) = concatMap ($ group)
     typ (GHC.L _ t) = case t of
         GHC.DataDecl name _ defn _ ->
             [decl name] ++ concatMap con (GHC.dd_cons defn)
+        GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
         _ -> pure . decl $ GHC.tcdLName t
     fun term = case cast term of
         (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name))

From 5c01af0e605c2bd16382cbd0de7102f1fbc2f361 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 2 Jul 2015 12:47:03 +0200
Subject: [PATCH 089/109] Add support for anchoring data family constructor
 declarations.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index c12ac35a22..b592326da6 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -129,20 +129,21 @@ binds =
 decls :: GHC.RenamedSource -> DetailsMap
 decls (group, _, _, _) = concatMap ($ group)
     [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
-    , everything (<|>) fun
+    , everything (<|>) (fun `combine` con)
     ]
   where
     typ (GHC.L _ t) = case t of
-        GHC.DataDecl name _ defn _ ->
-            [decl name] ++ concatMap con (GHC.dd_cons defn)
+        GHC.DataDecl name _ _ _ -> pure . decl $ name
         GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
         _ -> pure . decl $ GHC.tcdLName t
     fun term = case cast term of
         (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name))
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)
         _ -> empty
-    con (GHC.L _ t) =
-        map decl (GHC.con_names t) ++ everything (<|>) fld t
+    con term = case cast term of
+        (Just cdcl) ->
+            map decl (GHC.con_names cdcl) ++ everything (<|>) fld cdcl
+        Nothing -> empty
     fld term = case cast term of
         Just field -> map decl $ GHC.cd_fld_names field
         Nothing -> empty

From 28e93ceec440d0d1ed053bbf3c20e4bdcd6d5f4e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 2 Jul 2015 13:31:05 +0200
Subject: [PATCH 090/109] Improve support for hyperlinking type families.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs    | 8 +++++++-
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 1 +
 2 files changed, 8 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index b592326da6..4b60ca37cc 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -129,7 +129,7 @@ binds =
 decls :: GHC.RenamedSource -> DetailsMap
 decls (group, _, _, _) = concatMap ($ group)
     [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
-    , everything (<|>) (fun `combine` con)
+    , everything (<|>) (fun `combine` con `combine` ins)
     ]
   where
     typ (GHC.L _ t) = case t of
@@ -144,10 +144,16 @@ decls (group, _, _, _) = concatMap ($ group)
         (Just cdcl) ->
             map decl (GHC.con_names cdcl) ++ everything (<|>) fld cdcl
         Nothing -> empty
+    ins term = case cast term of
+        (Just (GHC.DataFamInstD inst)) -> pure . tyref $ GHC.dfid_tycon inst
+        (Just (GHC.TyFamInstD (GHC.TyFamInstDecl (GHC.L _ eqn) _))) ->
+            pure . tyref $ GHC.tfe_tycon eqn
+        _ -> empty
     fld term = case cast term of
         Just field -> map decl $ GHC.cd_fld_names field
         Nothing -> empty
     decl (GHC.L sspan name) = (sspan, RtkDecl name)
+    tyref (GHC.L sspan name) = (sspan, RtkType name)
 
 -- | Obtain details map for import declarations.
 --
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 019075a199..37cc5377c0 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -197,6 +197,7 @@ keywords =
     , "type"
     , "where"
     , "forall"
+    , "family"
     , "mdo"
     ]
 

From 0ea2c4a892346d4fdd38c50cf234dbc5e23ac299 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 2 Jul 2015 13:33:34 +0200
Subject: [PATCH 091/109] Add hyperlinker test case for checking type and type
 family declarations.

---
 hypsrc-test/ref/src/Types.html | 937 +++++++++++++++++++++++++++++++++
 hypsrc-test/src/Types.hs       |  42 ++
 2 files changed, 979 insertions(+)
 create mode 100644 hypsrc-test/ref/src/Types.html
 create mode 100644 hypsrc-test/src/Types.hs

diff --git a/hypsrc-test/ref/src/Types.html b/hypsrc-test/ref/src/Types.html
new file mode 100644
index 0000000000..bdb68ed679
--- /dev/null
+++ b/hypsrc-test/ref/src/Types.html
@@ -0,0 +1,937 @@
+<!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
+  ><link rel="stylesheet" type="text/css" href="style.css"
+     /><script type="text/javascript" src="highlight.js"
+    ></script
+    ></head
+  ><body
+  ><pre
+    ><span class="hs-pragma"
+      >{-# LANGUAGE TypeFamilies #-}</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-keyword"
+      >module</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >Types</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-keyword"
+      >data</span
+      ><span class=""
+      > </span
+      ><a name="Quux"
+      ><a href="Types.html#Quux"
+	><span class="hs-identifier"
+	  >Quux</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a name="Bar"
+      ><a href="Types.html#Bar"
+	><span class="hs-identifier"
+	  >Bar</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >|</span
+      ><span class=""
+      > </span
+      ><a name="Baz"
+      ><a href="Types.html#Baz"
+	><span class="hs-identifier"
+	  >Baz</span
+	  ></a
+	></a
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-keyword"
+      >newtype</span
+      ><span class=""
+      > </span
+      ><a name="Foo"
+      ><a href="Types.html#Foo"
+	><span class="hs-identifier"
+	  >Foo</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a name="Foo"
+      ><a href="Types.html#Foo"
+	><span class="hs-identifier"
+	  >Foo</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-keyword"
+      >type</span
+      ><span class=""
+      > </span
+      ><a name="FooQuux"
+      ><a href="Types.html#FooQuux"
+	><span class="hs-identifier"
+	  >FooQuux</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+</span
+      ><span class="hs-keyword"
+      >type</span
+      ><span class=""
+      > </span
+      ><a name="QuuxFoo"
+      ><a href="Types.html#QuuxFoo"
+	><span class="hs-identifier"
+	  >QuuxFoo</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-keyword"
+      >data</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >family</span
+      ><span class=""
+      > </span
+      ><a name="Norf"
+      ><a href="Types.html#Norf"
+	><span class="hs-identifier"
+	  >Norf</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >a</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >b</span
+	  ></a
+	></a
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-keyword"
+      >data</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >instance</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Norf"
+      ><span class="hs-identifier hs-type"
+	>Norf</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a name="NFQ"
+      ><a href="Types.html#NFQ"
+	><span class="hs-identifier"
+	  >NFQ</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class=""
+      >
+</span
+      ><span class="hs-keyword"
+      >data</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >instance</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Norf"
+      ><span class="hs-identifier hs-type"
+	>Norf</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a name="NQF"
+      ><a href="Types.html#NQF"
+	><span class="hs-identifier"
+	  >NQF</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-keyword"
+      >type</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >family</span
+      ><span class=""
+      > </span
+      ><a name="Norf%27"
+      ><a href="Types.html#Norf%27"
+	><span class="hs-identifier"
+	  >Norf'</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >a</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >b</span
+	  ></a
+	></a
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-keyword"
+      >type</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >instance</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Norf%27"
+      ><span class="hs-identifier hs-type"
+	>Norf'</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+</span
+      ><span class="hs-keyword"
+      >type</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >instance</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Norf%27"
+      ><span class="hs-identifier hs-type"
+	>Norf'</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-identifier"
+      >norf1</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Norf"
+      ><span class="hs-identifier hs-type"
+	>Norf</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+</span
+      ><a name="norf1"
+      ><a href="Types.html#norf1"
+	><span class="hs-identifier"
+	  >norf1</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#NFQ"
+      ><span class="hs-identifier hs-var"
+	>NFQ</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-var"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Bar"
+      ><span class="hs-identifier hs-var"
+	>Bar</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >0</span
+      ><span class=""
+      >
+</span
+      ><span class="hs-identifier"
+      >norf1</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#NFQ"
+      ><span class="hs-identifier hs-var"
+	>NFQ</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-var"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Baz"
+      ><span class="hs-identifier hs-var"
+	>Baz</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >1</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-identifier"
+      >norf2</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Norf"
+      ><span class="hs-identifier hs-type"
+	>Norf</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+</span
+      ><a name="norf2"
+      ><a href="Types.html#norf2"
+	><span class="hs-identifier"
+	  >norf2</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#NQF"
+      ><span class="hs-identifier hs-var"
+	>NQF</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Bar"
+      ><span class="hs-identifier hs-var"
+	>Bar</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-var"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >0</span
+      ><span class=""
+      >
+</span
+      ><span class="hs-identifier"
+      >norf2</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#NQF"
+      ><span class="hs-identifier hs-var"
+	>NQF</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Baz"
+      ><span class="hs-identifier hs-var"
+	>Baz</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-var"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >1</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-identifier"
+      >norf1'</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Norf%27"
+      ><span class="hs-identifier hs-type"
+	>Norf'</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+</span
+      ><a name="norf1%27"
+      ><a href="Types.html#norf1%27"
+	><span class="hs-identifier"
+	  >norf1'</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-var"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Bar"
+      ><span class="hs-identifier hs-var"
+	>Bar</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >0</span
+      ><span class=""
+      >
+</span
+      ><span class="hs-identifier"
+      >norf1'</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-var"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Baz"
+      ><span class="hs-identifier hs-var"
+	>Baz</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >1</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-identifier"
+      >norf2'</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Norf%27"
+      ><span class="hs-identifier hs-type"
+	>Norf'</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Quux"
+      ><span class="hs-identifier hs-type"
+	>Quux</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+</span
+      ><a name="norf2%27"
+      ><a href="Types.html#norf2%27"
+	><span class="hs-identifier"
+	  >norf2'</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#Bar"
+      ><span class="hs-identifier hs-var"
+	>Bar</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-var"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >0</span
+      ><span class=""
+      >
+</span
+      ><span class="hs-identifier"
+      >norf2'</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="Types.html#Baz"
+      ><span class="hs-identifier hs-var"
+	>Baz</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="Types.html#Foo"
+      ><span class="hs-identifier hs-var"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-number"
+      >1</span
+      ><span class=""
+      >
+</span
+      ></pre
+    ></body
+  ></html
+>
diff --git a/hypsrc-test/src/Types.hs b/hypsrc-test/src/Types.hs
new file mode 100644
index 0000000000..b63a825b95
--- /dev/null
+++ b/hypsrc-test/src/Types.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE TypeFamilies #-}
+
+
+module Types where
+
+
+data Quux = Bar | Baz
+
+newtype Foo = Foo ()
+
+type FooQuux = (Foo, Quux)
+type QuuxFoo = (Quux, Foo)
+
+
+data family Norf a b
+
+data instance Norf Foo Quux = NFQ Foo Quux
+data instance Norf Quux Foo = NQF Quux Foo
+
+
+type family Norf' a b
+
+type instance Norf' Foo Quux = (Foo, Quux)
+type instance Norf' Quux Foo = (Quux, Foo)
+
+
+norf1 :: Norf Foo Quux -> Int
+norf1 (NFQ (Foo ()) Bar) = 0
+norf1 (NFQ (Foo ()) Baz) = 1
+
+norf2 :: Norf Quux Foo -> Int
+norf2 (NQF Bar (Foo ())) = 0
+norf2 (NQF Baz (Foo ())) = 1
+
+
+norf1' :: Norf' Foo Quux -> Int
+norf1' (Foo (), Bar) = 0
+norf1' (Foo (), Baz) = 1
+
+norf2' :: Norf' Quux Foo -> Int
+norf2' (Bar, Foo ()) = 0
+norf2' (Baz, Foo ()) = 1

From aa6c6deba47af1c21765ed09dc0317825aa1d78d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 2 Jul 2015 13:41:38 +0200
Subject: [PATCH 092/109] Fix issue with operators being recognized as
 preprocessor directives.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 6 +++---
 hypsrc-test/src/Operators.hs                           | 4 ++++
 2 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 37cc5377c0..d927aa08b1 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -156,17 +156,17 @@ classify str
     | "--" `isPrefixOf` str = TkComment
     | "{-#" `isPrefixOf` str = TkPragma
     | "{-" `isPrefixOf` str = TkComment
-classify (c:_)
+classify str@(c:_)
     | isSpace c = TkSpace
     | isDigit c = TkNumber
     | c `elem` special = TkSpecial
+    | str `elem` glyphs = TkGlyph
+    | all (`elem` symbols) str = TkOperator
     | c == '#' = TkCpp
     | c == '"' = TkString
     | c == '\'' = TkChar
 classify str
     | str `elem` keywords = TkKeyword
-    | str `elem` glyphs = TkGlyph
-    | all (`elem` symbols) str = TkOperator
     | isIdentifier str = TkIdentifier
     | otherwise = TkUnknown
 
diff --git a/hypsrc-test/src/Operators.hs b/hypsrc-test/src/Operators.hs
index bc76c2d394..8e86ab0b71 100644
--- a/hypsrc-test/src/Operators.hs
+++ b/hypsrc-test/src/Operators.hs
@@ -16,3 +16,7 @@ a */\* b = concatMap (*** b) a
 
 (**/\**) :: [[a]] -> [[a]] -> [[a]]
 a **/\** b = zipWith (*/\*) [a +++ b] (a $$$ b)
+
+
+(#.#) :: a -> b -> (c -> (a, b))
+a #.# b = const $ (a, b)

From 257e0456854a0835bb9901b6d73c17f6f8d0d841 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 2 Jul 2015 17:18:12 +0200
Subject: [PATCH 093/109] Fix broken tests for parsing and hyperlinking hash
 operators.

---
 .../Backends/Hyperlinker/ParserSpec.hs        |   2 +-
 hypsrc-test/ref/src/Operators.html            | 122 ++++++++++++++++++
 2 files changed, 123 insertions(+), 1 deletion(-)

diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
index 38cdbc87e2..a76bdcdc51 100644
--- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
+++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
@@ -52,7 +52,7 @@ parseSpec = do
     it "should recognize preprocessor directives" $ do
         "\n#define foo bar" `shouldParseTo` [TkSpace, TkCpp]
         "x # y" `shouldParseTo`
-            [TkIdentifier, TkSpace, TkCpp, TkSpace,TkIdentifier]
+            [TkIdentifier, TkSpace, TkOperator, TkSpace,TkIdentifier]
 
     it "should distinguish basic language constructs" $ do
         "(* 2) <$> (\"abc\", foo)" `shouldParseTo`
diff --git a/hypsrc-test/ref/src/Operators.html b/hypsrc-test/ref/src/Operators.html
index 9ed24ab9c3..beefda58fa 100644
--- a/hypsrc-test/ref/src/Operators.html
+++ b/hypsrc-test/ref/src/Operators.html
@@ -648,6 +648,128 @@
       >)</span
       ><span class=""
       >
+
+
+</span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-operator"
+      >#.#</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>b</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>c</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>b</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+</span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >a</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="%23.%23"
+      ><a href="Operators.html#%23.%23"
+	><span class="hs-operator"
+	  >#.#</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >b</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >const</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >$</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>b</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
 </span
       ></pre
     ></body

From d761512f239b17f8e9824629595d75aa46e55554 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 2 Jul 2015 18:53:28 +0200
Subject: [PATCH 094/109] Add support for anchoring signatures in type class
 declarations.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 4b60ca37cc..98c9770f37 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
+
 
 module Haddock.Backends.Hyperlinker.Ast
     ( enrich
@@ -135,6 +137,7 @@ decls (group, _, _, _) = concatMap ($ group)
     typ (GHC.L _ t) = case t of
         GHC.DataDecl name _ _ _ -> pure . decl $ name
         GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
+        GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs
         _ -> pure . decl $ GHC.tcdLName t
     fun term = case cast term of
         (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name))
@@ -152,6 +155,8 @@ decls (group, _, _, _) = concatMap ($ group)
     fld term = case cast term of
         Just field -> map decl $ GHC.cd_fld_names field
         Nothing -> empty
+    sig (GHC.L _ (GHC.TypeSig names _ _)) = map decl names
+    sig _ = []
     decl (GHC.L sspan name) = (sspan, RtkDecl name)
     tyref (GHC.L sspan name) = (sspan, RtkType name)
 

From ef3b8691ea607bd4f67d5dc77bb226cf57ec4c30 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 2 Jul 2015 19:04:47 +0200
Subject: [PATCH 095/109] Make hyperlinker generate anchors only to top-level
 value bindings.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 98c9770f37..1e121c2e23 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -131,7 +131,8 @@ binds =
 decls :: GHC.RenamedSource -> DetailsMap
 decls (group, _, _, _) = concatMap ($ group)
     [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
-    , everything (<|>) (fun `combine` con `combine` ins)
+    , everything (<|>) fun . GHC.hs_valds
+    , everything (<|>) (con `combine` ins)
     ]
   where
     typ (GHC.L _ t) = case t of

From 29bb1ce86e12b368c4eb91dbf515391a0958b8c3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Thu, 2 Jul 2015 19:05:58 +0200
Subject: [PATCH 096/109] Create hyperlinker test case for type classes.

---
 hypsrc-test/ref/src/Classes.html | 931 +++++++++++++++++++++++++++++++
 hypsrc-test/src/Classes.hs       |  38 ++
 2 files changed, 969 insertions(+)
 create mode 100644 hypsrc-test/ref/src/Classes.html
 create mode 100644 hypsrc-test/src/Classes.hs

diff --git a/hypsrc-test/ref/src/Classes.html b/hypsrc-test/ref/src/Classes.html
new file mode 100644
index 0000000000..a5a3d243f4
--- /dev/null
+++ b/hypsrc-test/ref/src/Classes.html
@@ -0,0 +1,931 @@
+<!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
+  ><link rel="stylesheet" type="text/css" href="style.css"
+     /><script type="text/javascript" src="highlight.js"
+    ></script
+    ></head
+  ><body
+  ><pre
+    ><span class="hs-keyword"
+      >module</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >Classes</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-keyword"
+      >class</span
+      ><span class=""
+      > </span
+      ><a name="Foo"
+      ><a href="Classes.html#Foo"
+	><span class="hs-identifier"
+	  >Foo</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >a</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+    </span
+      ><a name="bar"
+      ><a href="Classes.html#bar"
+	><span class="hs-identifier"
+	  >bar</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      >
+    </span
+      ><a name="baz"
+      ><a href="Classes.html#baz"
+	><span class="hs-identifier"
+	  >baz</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-keyword"
+      >instance</span
+      ><span class=""
+      > </span
+      ><a href="Classes.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+    </span
+      ><a name="local-0"
+      ><a href="Classes.html#bar"
+	><span class="hs-identifier"
+	  >bar</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >id</span
+      ><span class=""
+      >
+    </span
+      ><a name="local-0"
+      ><a href="Classes.html#baz"
+	><span class="hs-identifier"
+	  >baz</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >x</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-keyword"
+      >instance</span
+      ><span class=""
+      > </span
+      ><a href="Classes.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+    </span
+      ><a name="local-0"
+      ><a href="Classes.html#bar"
+	><span class="hs-identifier"
+	  >bar</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >length</span
+      ><span class=""
+      >
+    </span
+      ><a name="local-0"
+      ><a href="Classes.html#baz"
+	><span class="hs-identifier"
+	  >baz</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >_</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><span class="hs-special"
+      >]</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-keyword"
+      >class</span
+      ><span class=""
+      > </span
+      ><a href="Classes.html#Foo"
+      ><span class="hs-identifier hs-type"
+	>Foo</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=&gt;</span
+      ><span class=""
+      > </span
+      ><a name="Foo%27"
+      ><a href="Classes.html#Foo%27"
+	><span class="hs-identifier"
+	  >Foo'</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >a</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+    </span
+      ><a name="quux"
+      ><a href="Classes.html#quux"
+	><span class="hs-identifier"
+	  >quux</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class=""
+      >
+    </span
+      ><a name="local-0"
+      ><a href="Classes.html#quux"
+	><span class="hs-identifier"
+	  >quux</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >x</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >y</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Classes.html#norf"
+      ><span class="hs-identifier hs-var"
+	>norf</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>x</span
+	></a
+      ><span class="hs-special"
+      >,</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>y</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > 
+
+    </span
+      ><a name="norf"
+      ><a href="Classes.html#norf"
+	><span class="hs-identifier"
+	  >norf</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class=""
+      >
+    </span
+      ><a name="local-0"
+      ><a href="Classes.html#norf"
+	><span class="hs-identifier"
+	  >norf</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><a href="Classes.html#quux"
+      ><span class="hs-identifier hs-var"
+	>quux</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >.</span
+      ><span class=""
+      > </span
+      ><a href="Classes.html#baz"
+      ><span class="hs-identifier hs-var"
+	>baz</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >.</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >sum</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >.</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >map</span
+      ><span class=""
+      > </span
+      ><a href="Classes.html#bar"
+      ><span class="hs-identifier hs-var"
+	>bar</span
+	></a
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-keyword"
+      >instance</span
+      ><span class=""
+      > </span
+      ><a href="Classes.html#Foo%27"
+      ><span class="hs-identifier hs-type"
+	>Foo'</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Int</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+    </span
+      ><a name="local-0"
+      ><a href="Classes.html#norf"
+	><span class="hs-identifier"
+	  >norf</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >sum</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-keyword"
+      >instance</span
+      ><span class=""
+      > </span
+      ><a href="Classes.html#Foo%27"
+      ><span class="hs-identifier hs-type"
+	>Foo'</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >[</span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >]</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+    </span
+      ><a name="local-0"
+      ><a href="Classes.html#quux"
+	><span class="hs-identifier"
+	  >quux</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >uncurry</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-operator hs-var"
+      >++</span
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+
+
+</span
+      ><span class="hs-keyword"
+      >class</span
+      ><span class=""
+      > </span
+      ><a name="Plugh"
+      ><a href="Classes.html#Plugh"
+	><span class="hs-identifier"
+	  >Plugh</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >p</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+    </span
+      ><a name="plugh"
+      ><a href="Classes.html#plugh"
+	><span class="hs-identifier"
+	  >plugh</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >::</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>p</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>p</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>b</span
+	></a
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>b</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>p</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>b</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>b</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >-&gt;</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-type"
+	>a</span
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      >
+
+</span
+      ><span class="hs-keyword"
+      >instance</span
+      ><span class=""
+      > </span
+      ><a href="Classes.html#Plugh"
+      ><span class="hs-identifier hs-type"
+	>Plugh</span
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-type"
+      >Either</span
+      ><span class=""
+      > </span
+      ><span class="hs-keyword"
+      >where</span
+      ><span class=""
+      >
+    </span
+      ><a name="local-0"
+      ><a href="Classes.html#plugh"
+	><span class="hs-identifier"
+	  >plugh</span
+	  ></a
+	></a
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-identifier hs-var"
+      >Left</span
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >a</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >_</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >Right</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >$</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >const</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>a</span
+	></a
+      ><span class=""
+      >
+    </span
+      ><span class="hs-identifier"
+      >plugh</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-identifier hs-var"
+      >Right</span
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >a</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >_</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >Right</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >$</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >const</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>a</span
+	></a
+      ><span class=""
+      >
+    </span
+      ><span class="hs-identifier"
+      >plugh</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >_</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-identifier hs-var"
+      >Left</span
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >b</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >Left</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >$</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >const</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>b</span
+	></a
+      ><span class=""
+      >
+    </span
+      ><span class="hs-identifier"
+      >plugh</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier"
+      >_</span
+      ><span class=""
+      > </span
+      ><span class="hs-special"
+      >(</span
+      ><span class="hs-identifier hs-var"
+      >Right</span
+      ><span class=""
+      > </span
+      ><a name="local-0"
+      ><a href="#local-0"
+	><span class="hs-identifier"
+	  >b</span
+	  ></a
+	></a
+      ><span class="hs-special"
+      >)</span
+      ><span class=""
+      > </span
+      ><span class="hs-glyph"
+      >=</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >Left</span
+      ><span class=""
+      > </span
+      ><span class="hs-operator hs-var"
+      >$</span
+      ><span class=""
+      > </span
+      ><span class="hs-identifier hs-var"
+      >const</span
+      ><span class=""
+      > </span
+      ><a href="#local-0"
+      ><span class="hs-identifier hs-var"
+	>b</span
+	></a
+      ><span class=""
+      >
+</span
+      ></pre
+    ></body
+  ></html
+>
diff --git a/hypsrc-test/src/Classes.hs b/hypsrc-test/src/Classes.hs
new file mode 100644
index 0000000000..bddb9939a0
--- /dev/null
+++ b/hypsrc-test/src/Classes.hs
@@ -0,0 +1,38 @@
+module Classes where
+
+
+class Foo a where
+    bar :: a -> Int
+    baz :: Int -> (a, a)
+
+instance Foo Int where
+    bar = id
+    baz x = (x, x)
+
+instance Foo [a] where
+    bar = length
+    baz _ = ([], [])
+
+
+class Foo a => Foo' a where
+    quux :: (a, a) -> a
+    quux (x, y) = norf [x, y] 
+
+    norf :: [a] -> a
+    norf = quux . baz . sum . map bar
+
+instance Foo' Int where
+    norf = sum
+
+instance Foo' [a] where
+    quux = uncurry (++)
+
+
+class Plugh p where
+    plugh :: p a a -> p b b -> p (a -> b) (b -> a)
+
+instance Plugh Either where
+    plugh (Left a) _ = Right $ const a
+    plugh (Right a) _ = Right $ const a
+    plugh _ (Left b) = Left $ const b
+    plugh _ (Right b) = Left $ const b

From 9c156cdcfd7d042ed9cfa242871846291af5cf0a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sat, 4 Jul 2015 16:28:26 +0200
Subject: [PATCH 097/109] Update docs with information about source
 hyperlinking.

---
 doc/haddock.xml | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)

diff --git a/doc/haddock.xml b/doc/haddock.xml
index b528fdb5de..6c83f6188f 100644
--- a/doc/haddock.xml
+++ b/doc/haddock.xml
@@ -528,6 +528,43 @@ $ pdflatex <replaceable>package</replaceable>.tex</screen>
         </listitem>
       </varlistentry>
 
+      <varlistentry>
+        <term>
+          <indexterm><primary><option>--hyperlinked-source</option></primary></indexterm>
+          <option>--hyperlinked-source</option>
+        </term>
+        <listitem>
+          <para>Generate hyperlinked source code (as HTML web page). All
+          rendered files will be put into
+          <filename class='directory'>src/</filename> subfolder of output
+          directory.</para>
+          <para>Usually, this should be used in combination with
+          <option>--html</option> option - generated documentation will then
+          contain references to appropriate code fragments. Previously, this
+          behaviour could be achieved by generating sources using external
+          tool and specifying <option>--source-base</option>,
+          <option>--source-module</option>, <option>--source-entity</option>
+          and related options. Note that these flags are ignored once
+          <option>--hyperlinked-source</option> is set.</para>
+          <para>In order to make cross-package source hyperlinking possible,
+          appropriate source paths have to be set up when providing
+          interface files using <option>--read-interface</option>
+          option.</para>
+        </listitem>
+      </varlistentry>
+
+      <varlistentry>
+        <term>
+          <indexterm><primary><option>--source-style</option></primary></indexterm>
+          <option>--source-style=<replaceable>style</replaceable></option>
+        </term>
+        <listitem>
+          <para>Use custom CSS file for sources rendered by the
+          <option>--hyperlinked-source</option> option. If no custom style
+          file is provided, Haddock will use default one.</para>
+        </listitem>
+      </varlistentry>
+
       <varlistentry>
         <term>
           <indexterm><primary><option>-S</option></primary></indexterm>

From 820381b78d1f0f7487e120c22913629863a8d1eb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sat, 4 Jul 2015 16:52:15 +0200
Subject: [PATCH 098/109] Update docs on using `--read-interface` option.

---
 doc/haddock.xml | 36 +++++++++++++++++++++++++++++-------
 1 file changed, 29 insertions(+), 7 deletions(-)

diff --git a/doc/haddock.xml b/doc/haddock.xml
index 6c83f6188f..b28006f6c7 100644
--- a/doc/haddock.xml
+++ b/doc/haddock.xml
@@ -345,11 +345,27 @@
       <varlistentry>
         <term>
           <indexterm><primary><option>-i</option></primary></indexterm>
-          <option>-i</option> <replaceable>path</replaceable>,<replaceable>file</replaceable>
+          <option>-i</option> <replaceable>file</replaceable>
+        </term>
+        <term>
+          <indexterm><primary><option>-i</option></primary></indexterm>
+          <option>-i</option> <replaceable>docpath</replaceable>,<replaceable>file</replaceable>
+        </term>
+        <term>
+          <indexterm><primary><option>-i</option></primary></indexterm>
+          <option>-i</option> <replaceable>docpath</replaceable>,<replaceable>srcpath</replaceable>,<replaceable>file</replaceable>
+        </term>
+        <term>
+          <indexterm><primary><option>--read-interface</option></primary></indexterm>
+          <option>--read-interface</option>=<replaceable>file</replaceable>
         </term>
         <term>
           <indexterm><primary><option>--read-interface</option></primary></indexterm>
-          <option>--read-interface</option>=<replaceable>path</replaceable>,<replaceable>file</replaceable>
+          <option>--read-interface</option>=<replaceable>docpath</replaceable>,<replaceable>file</replaceable>
+        </term>
+        <term>
+          <indexterm><primary><option>--read-interface</option></primary></indexterm>
+          <option>--read-interface</option>=<replaceable>docpath</replaceable>,<replaceable>srcpath</replaceable>,<replaceable>file</replaceable>
         </term>
         <listitem>
           <para>Read the interface file in
@@ -357,19 +373,25 @@
           produced by running Haddock with the
           <option>--dump-interface</option> option.  The interface
           describes a set of modules whose HTML documentation is
-          located in <replaceable>path</replaceable> (which may be a
-          relative pathname).  The <replaceable>path</replaceable> is
-          optional, and defaults to <quote>.</quote>.</para>
+          located in <replaceable>docpath</replaceable> (which may be a
+          relative pathname).  The <replaceable>docpath</replaceable> is
+          optional, and defaults to <quote>.</quote>. The
+          <replaceable>srcpath</replaceable> is optional but has no default
+          value.</para>
 
           <para>This option allows Haddock to produce separate sets of
           documentation with hyperlinks between them.  The
-          <replaceable>path</replaceable> is used to direct hyperlinks
+          <replaceable>docpath</replaceable> is used to direct hyperlinks
           to point to the right files; so make sure you don't move the
           HTML files later or these links will break.  Using a
-          relative <replaceable>path</replaceable> means that a
+          relative <replaceable>docpath</replaceable> means that a
           documentation subtree can still be moved around without
           breaking links.</para>
 
+          <para>Similarly to <replaceable>docpath</replaceable>, <replaceable>srcpath</replaceable> is used generate cross-package hyperlinks but
+          within sources rendered with <option>--hyperlinked-source</option>
+          option.</para>
+
           <para>Multiple <option>--read-interface</option> options may
           be given.</para>
         </listitem>

From a86147030e0f8fe33ebd4b358ac04d3beb45c3f8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sat, 4 Jul 2015 17:15:26 +0200
Subject: [PATCH 099/109] Remove potentially dangerous record access in
 hyperlinker AST module.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 1e121c2e23..9d5c127dd5 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -137,9 +137,9 @@ decls (group, _, _, _) = concatMap ($ group)
   where
     typ (GHC.L _ t) = case t of
         GHC.DataDecl name _ _ _ -> pure . decl $ name
+        GHC.SynDecl name _ _ _ -> pure . decl $ name
         GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
         GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs
-        _ -> pure . decl $ GHC.tcdLName t
     fun term = case cast term of
         (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ _ :: GHC.HsBind GHC.Name))
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)

From cab1191dfb7738c020a1eef9e9d4efe6c4f27a51 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sat, 4 Jul 2015 17:40:10 +0200
Subject: [PATCH 100/109] Make Haddock generate warnings about potential misuse
 of hyperlinker.

---
 haddock-api/src/Haddock.hs | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 02e1953124..5a1c6abe49 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -159,6 +159,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do
           _ -> return flags
 
   unless (Flag_NoWarnings `elem` flags) $ do
+    hypSrcWarnings flags
     forM_ (warnings args) $ \warning -> do
       hPutStrLn stderr warning
 
@@ -491,6 +492,35 @@ shortcutFlags flags = do
       ++ "Ported to use the GHC API by David Waern 2006-2008\n"
 
 
+-- | Generate some warnings about potential misuse of @--hyperlinked-source@.
+hypSrcWarnings :: [Flag] -> IO ()
+hypSrcWarnings flags = do
+
+    when (hypSrc && any isSourceUrlFlag flags) $
+        hPutStrLn stderr $ concat
+            [ "Warning: "
+            , "--source-* options are ignored when "
+            , "--hyperlinked-source is enabled."
+            ]
+
+    when (not hypSrc && any isSourceCssFlag flags) $
+        hPutStrLn stderr $ concat
+            [ "Warning: "
+            , "source CSS file is specified but "
+            , "--hyperlinked-source is disabled."
+            ]
+
+  where
+    hypSrc = Flag_HyperlinkedSource `elem` flags
+    isSourceUrlFlag (Flag_SourceBaseURL _) = True
+    isSourceUrlFlag (Flag_SourceModuleURL _) = True
+    isSourceUrlFlag (Flag_SourceEntityURL _) = True
+    isSourceUrlFlag (Flag_SourceLEntityURL _) = True
+    isSourceUrlFlag _ = False
+    isSourceCssFlag (Flag_SourceCss _) = True
+    isSourceCssFlag _ = False
+
+
 updateHTMLXRefs :: [(DocPaths, InterfaceFile)] -> IO ()
 updateHTMLXRefs packages = do
   writeIORef html_xrefs_ref (Map.fromList mapping)

From 861c45b6c16e76e901553739bdb7d7c7e2f827f0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sat, 4 Jul 2015 17:43:22 +0200
Subject: [PATCH 101/109] Fix incorrect specification of source style option in
 doc file.

---
 doc/haddock.xml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/doc/haddock.xml b/doc/haddock.xml
index b28006f6c7..e284521248 100644
--- a/doc/haddock.xml
+++ b/doc/haddock.xml
@@ -577,8 +577,8 @@ $ pdflatex <replaceable>package</replaceable>.tex</screen>
 
       <varlistentry>
         <term>
-          <indexterm><primary><option>--source-style</option></primary></indexterm>
-          <option>--source-style=<replaceable>style</replaceable></option>
+          <indexterm><primary><option>--source-css</option></primary></indexterm>
+          <option>--source-css=<replaceable>style</replaceable></option>
         </term>
         <listitem>
           <para>Use custom CSS file for sources rendered by the

From 99980dcc63d696c7912ff1f0d2faadcce169f184 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 5 Jul 2015 17:06:36 +0200
Subject: [PATCH 102/109] Refactor source path mapping to use modules as
 indices.

---
 haddock-api/src/Haddock.hs                    | 27 ++++++++------
 .../src/Haddock/Backends/Hyperlinker.hs       | 15 ++++----
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 36 +++++++++----------
 haddock-api/src/Haddock/InterfaceFile.hs      | 11 +++---
 haddock-api/src/Haddock/Types.hs              |  9 ++++-
 5 files changed, 55 insertions(+), 43 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 5a1c6abe49..5c48d28bca 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -46,6 +46,7 @@ import Data.List (isPrefixOf)
 import Control.Exception
 import Data.Maybe
 import Data.IORef
+import Data.Map (Map)
 import qualified Data.Map as Map
 import System.IO
 import System.Exit
@@ -228,13 +229,14 @@ renderStep dflags flags qual pkgs interfaces = do
   let
     ifaceFiles = map snd pkgs
     installedIfaces = concatMap ifInstalledIfaces ifaceFiles
-    srcMap = Map.fromList [ (ifPackageKey if_, x) | ((_, Just x), if_) <- pkgs ]
-  render dflags flags qual interfaces installedIfaces srcMap
+    extSrcMap = Map.fromList
+      [ (ifModule ifile, path) | ((_, Just path), ifile) <- pkgs ]
+  render dflags flags qual interfaces installedIfaces extSrcMap
 
 
 -- | Render the interfaces with whatever backend is specified in the flags.
-render :: DynFlags -> [Flag] -> QualOption -> [Interface] -> [InstalledInterface] -> SrcMap -> IO ()
-render dflags flags qual ifaces installedIfaces srcMap = do
+render :: DynFlags -> [Flag] -> QualOption -> [Interface] -> [InstalledInterface] -> Map Module FilePath -> IO ()
+render dflags flags qual ifaces installedIfaces extSrcMap = do
 
   let
     title                = fromMaybe "" (optTitle flags)
@@ -264,15 +266,20 @@ render dflags flags qual ifaces installedIfaces srcMap = do
       | Flag_HyperlinkedSource `elem` flags = Just hypSrcModuleUrlFormat
       | otherwise = srcModule
 
-    srcMap'
+    srcMap = Map.union
+      (Map.map SrcExternal extSrcMap)
+      (Map.fromList [ (ifaceMod iface, SrcLocal) | iface <- ifaces ])
+
+    pkgSrcMap = Map.mapKeys modulePackageKey extSrcMap
+    pkgSrcMap'
       | Flag_HyperlinkedSource `elem` flags =
-          Map.insert pkgKey hypSrcModuleNameUrlFormat srcMap
-      | Just srcNameUrl <- srcEntity = Map.insert pkgKey srcNameUrl srcMap
-      | otherwise = srcMap
+          Map.insert pkgKey hypSrcModuleNameUrlFormat pkgSrcMap
+      | Just srcNameUrl <- srcEntity = Map.insert pkgKey srcNameUrl pkgSrcMap
+      | otherwise = pkgSrcMap
 
     -- TODO: Get these from the interface files as with srcMap
     srcLMap' = maybe Map.empty (\path -> Map.singleton pkgKey path) srcLEntity
-    sourceUrls' = (srcBase, srcModule', srcMap', srcLMap')
+    sourceUrls' = (srcBase, srcModule', pkgSrcMap', srcLMap')
 
   libDir   <- getHaddockLibDir flags
   prologue <- getPrologue dflags flags
@@ -322,7 +329,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do
                   libDir
 
   when (Flag_HyperlinkedSource `elem` flags) $ do
-    ppHyperlinkedSource odir libDir opt_source_css pretty pkgKey srcMap ifaces
+    ppHyperlinkedSource odir libDir opt_source_css pretty srcMap ifaces
 
 -- | From GHC 7.10, this function has a potential to crash with a
 -- nasty message such as @expectJust getPackageDetails@ because
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 1fadef4976..f007f97040 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -8,7 +8,6 @@ import Haddock.Backends.Hyperlinker.Renderer
 import Haddock.Backends.Hyperlinker.Utils
 
 import Text.XHtml hiding ((</>))
-import GHC
 
 import Data.Maybe
 import System.Directory
@@ -24,30 +23,28 @@ ppHyperlinkedSource :: FilePath -- ^ Output directory
                     -> FilePath -- ^ Resource directory
                     -> Maybe FilePath -- ^ Custom CSS file path
                     -> Bool -- ^ Flag indicating whether to pretty-print HTML
-                    -> PackageKey -- ^ Package for which we create source
-                    -> SrcMap -- ^ Paths to external sources
+                    -> SrcMap -- ^ Paths to sources
                     -> [Interface] -- ^ Interfaces for which we create source
                     -> IO ()
-ppHyperlinkedSource outdir libdir mstyle pretty pkg srcs ifaces = do
+ppHyperlinkedSource outdir libdir mstyle pretty srcs ifaces = do
     createDirectoryIfMissing True srcdir
     let cssFile = fromMaybe (defaultCssFile libdir) mstyle
     copyFile cssFile $ srcdir </> srcCssFile
     copyFile (libdir </> "html" </> highlightScript) $
         srcdir </> highlightScript
-    mapM_ (ppHyperlinkedModuleSource srcdir pretty pkg srcs) ifaces
+    mapM_ (ppHyperlinkedModuleSource srcdir pretty srcs) ifaces
   where
     srcdir = outdir </> hypSrcDir
 
 -- | Generate hyperlinked source for particular interface.
-ppHyperlinkedModuleSource :: FilePath -> Bool
-                          -> PackageKey -> SrcMap -> Interface
+ppHyperlinkedModuleSource :: FilePath -> Bool -> SrcMap -> Interface
                           -> IO ()
-ppHyperlinkedModuleSource srcdir pretty pkg srcs iface =
+ppHyperlinkedModuleSource srcdir pretty srcs iface =
     case ifaceTokenizedSrc iface of
         Just tokens -> writeFile path . html . render' $ tokens
         Nothing -> return ()
   where
-    render' = render (Just srcCssFile) (Just highlightScript) pkg srcs
+    render' = render (Just srcCssFile) (Just highlightScript) srcs
     html = if pretty then renderHtml else showHtml
     path = srcdir </> hypSrcModuleFile (ifaceMod iface)
 
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index ddb2e5b932..a4d7bc2d2a 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -23,10 +23,9 @@ import qualified Text.XHtml as Html
 type StyleClass = String
 
 
-render :: Maybe FilePath -> Maybe FilePath
-       -> GHC.PackageKey -> SrcMap -> [RichToken]
+render :: Maybe FilePath -> Maybe FilePath -> SrcMap -> [RichToken]
        -> Html
-render mcss mjs pkg srcs tokens = header mcss mjs <> body pkg srcs tokens
+render mcss mjs srcs tokens = header mcss mjs <> body srcs tokens
 
 
 data TokenGroup
@@ -53,11 +52,11 @@ groupTokens ((RichToken tok (Just det)):rest) =
     same _ = False
 
 
-body :: GHC.PackageKey -> SrcMap -> [RichToken] -> Html
-body pkg srcs tokens =
+body :: SrcMap -> [RichToken] -> Html
+body srcs tokens =
     Html.body . Html.pre $ hypsrc
   where
-    hypsrc = mconcat . map (tokenGroup pkg srcs) . groupTokens $ tokens
+    hypsrc = mconcat . map (tokenGroup srcs) . groupTokens $ tokens
 
 
 header :: Maybe FilePath -> Maybe FilePath -> Html
@@ -79,13 +78,13 @@ header mcss mjs =
         ]
 
 
-tokenGroup :: GHC.PackageKey -> SrcMap -> TokenGroup -> Html
-tokenGroup _ _ (GrpNormal tok) =
+tokenGroup :: SrcMap -> TokenGroup -> Html
+tokenGroup _ (GrpNormal tok) =
     tokenSpan tok ! attrs
   where
     attrs = [ multiclass . tokenStyle . tkType $ tok ]
-tokenGroup pkg srcs (GrpRich det tokens) =
-    externalAnchor det . internalAnchor det . hyperlink pkg srcs det $ content
+tokenGroup srcs (GrpRich det tokens) =
+    externalAnchor det . internalAnchor det . hyperlink srcs det $ content
   where
     content = mconcat . map (richToken det) $ tokens
 
@@ -140,28 +139,27 @@ externalAnchorIdent = hypSrcNameUrl
 internalAnchorIdent :: GHC.Name -> String
 internalAnchorIdent = ("local-" ++) . show . GHC.getKey . GHC.nameUnique
 
-hyperlink :: GHC.PackageKey -> SrcMap -> TokenDetails -> Html -> Html
-hyperlink pkg srcs details = case rtkName details of
+hyperlink :: SrcMap -> TokenDetails -> Html -> Html
+hyperlink srcs details = case rtkName details of
     Left name ->
         if GHC.isInternalName name
         then internalHyperlink name
-        else externalNameHyperlink pkg srcs name
+        else externalNameHyperlink srcs name
     Right name -> externalModHyperlink name
 
 internalHyperlink :: GHC.Name -> Html -> Html
 internalHyperlink name content =
     Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ]
 
-externalNameHyperlink :: GHC.PackageKey -> SrcMap -> GHC.Name -> Html -> Html
-externalNameHyperlink pkg srcs name content
-    | namePkg == pkg = Html.anchor content !
+externalNameHyperlink :: SrcMap -> GHC.Name -> Html -> Html
+externalNameHyperlink srcs name content = case Map.lookup mdl srcs of
+    Just SrcLocal -> Html.anchor content !
         [ Html.href $ hypSrcModuleNameUrl mdl name ]
-    | Just path <- Map.lookup namePkg srcs = Html.anchor content !
+    Just (SrcExternal path) -> Html.anchor content !
         [ Html.href $ path </> hypSrcModuleNameUrl mdl name ]
-    | otherwise = content
+    Nothing -> content
   where
     mdl = GHC.nameModule name
-    namePkg = GHC.modulePackageKey mdl
 
 -- TODO: Implement module hyperlinks.
 --
diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs
index 4b39d31546..d5762ce8e2 100644
--- a/haddock-api/src/Haddock/InterfaceFile.hs
+++ b/haddock-api/src/Haddock/InterfaceFile.hs
@@ -14,7 +14,7 @@
 -- Reading and writing the .haddock interface file
 -----------------------------------------------------------------------------
 module Haddock.InterfaceFile (
-  InterfaceFile(..), ifPackageKey,
+  InterfaceFile(..), ifModule, ifPackageKey,
   readInterfaceFile, nameCacheFromGhc, freshNameCache, NameCacheAccessor,
   writeInterfaceFile, binaryInterfaceVersion, binaryInterfaceVersionCompatibility
 ) where
@@ -51,11 +51,14 @@ data InterfaceFile = InterfaceFile {
 }
 
 
-ifPackageKey :: InterfaceFile -> PackageKey
-ifPackageKey if_ =
+ifModule :: InterfaceFile -> Module
+ifModule if_ =
   case ifInstalledIfaces if_ of
     [] -> error "empty InterfaceFile"
-    iface:_ -> modulePackageKey $ instMod iface
+    iface:_ -> instMod iface
+
+ifPackageKey :: InterfaceFile -> PackageKey
+ifPackageKey = modulePackageKey . ifModule
 
 
 binaryInterfaceMagic :: Word32
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index fbb5f44c42..da4b3eec14 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -50,7 +50,7 @@ type SubMap        = Map Name [Name]
 type DeclMap       = Map Name [LHsDecl Name]
 type InstMap       = Map SrcSpan Name
 type FixMap        = Map Name Fixity
-type SrcMap        = Map PackageKey FilePath
+type SrcMap        = Map Module SrcPath
 type DocPaths      = (FilePath, Maybe FilePath) -- paths to HTML and sources
 
 
@@ -271,6 +271,13 @@ unrenameDocForDecl (doc, fnArgsDoc) =
 -- | Type of environment used to cross-reference identifiers in the syntax.
 type LinkEnv = Map Name Module
 
+-- | Path for making cross-package hyperlinks in generated sources.
+--
+-- Used in 'SrcMap' to determine whether module originates in current package
+-- or in an external package.
+data SrcPath
+  = SrcExternal FilePath
+  | SrcLocal
 
 -- | Extends 'Name' with cross-reference information.
 data DocName

From 5927bfd4737532e7f1282672a96c2a2cb83c847f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Sun, 5 Jul 2015 17:47:34 +0200
Subject: [PATCH 103/109] Fix bug where not all module interfaces were added to
 source mapping.

---
 haddock-api/src/Haddock.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 5c48d28bca..d4d8e3e602 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -229,8 +229,10 @@ renderStep dflags flags qual pkgs interfaces = do
   let
     ifaceFiles = map snd pkgs
     installedIfaces = concatMap ifInstalledIfaces ifaceFiles
-    extSrcMap = Map.fromList
-      [ (ifModule ifile, path) | ((_, Just path), ifile) <- pkgs ]
+    extSrcMap = Map.fromList $ do
+      ((_, Just path), ifile) <- pkgs
+      iface <- ifInstalledIfaces ifile
+      return (instMod iface, path)
   render dflags flags qual interfaces installedIfaces extSrcMap
 
 

From fcaa46b054fc3b5a5535a748d3c3283629e3eadf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 6 Jul 2015 16:39:57 +0200
Subject: [PATCH 104/109] Extract main hyperlinker types to separate module.

---
 haddock-api/haddock-api.cabal                 |  1 +
 .../src/Haddock/Backends/Hyperlinker.hs       |  1 +
 .../src/Haddock/Backends/Hyperlinker/Ast.hs   | 27 +--------
 .../Haddock/Backends/Hyperlinker/Parser.hs    | 40 ++-----------
 .../Haddock/Backends/Hyperlinker/Renderer.hs  |  4 +-
 .../src/Haddock/Backends/Hyperlinker/Types.hs | 59 +++++++++++++++++++
 .../src/Haddock/Backends/Hyperlinker/Utils.hs |  1 +
 haddock-api/src/Haddock/Interface/Create.hs   |  1 +
 haddock-api/src/Haddock/Types.hs              |  3 +-
 haddock.cabal                                 |  5 ++
 10 files changed, 79 insertions(+), 63 deletions(-)
 create mode 100644 haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 11567f99b6..3838c3d82a 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -85,6 +85,7 @@ library
     Haddock.Backends.Hyperlinker.Ast
     Haddock.Backends.Hyperlinker.Parser
     Haddock.Backends.Hyperlinker.Renderer
+    Haddock.Backends.Hyperlinker.Types
     Haddock.Backends.Hyperlinker.Utils
     Haddock.ModuleTree
     Haddock.Types
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index f007f97040..4b58190c60 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -3,6 +3,7 @@ module Haddock.Backends.Hyperlinker
     , module Haddock.Backends.Hyperlinker.Utils
     ) where
 
+
 import Haddock.Types
 import Haddock.Backends.Hyperlinker.Renderer
 import Haddock.Backends.Hyperlinker.Utils
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 9d5c127dd5..28fdc3f5c9 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -3,12 +3,10 @@
 {-# LANGUAGE RecordWildCards #-}
 
 
-module Haddock.Backends.Hyperlinker.Ast
-    ( enrich
-    , RichToken(..), TokenDetails(..), rtkName
-    ) where
+module Haddock.Backends.Hyperlinker.Ast (enrich) where
 
-import Haddock.Backends.Hyperlinker.Parser
+
+import Haddock.Backends.Hyperlinker.Types
 
 import qualified GHC
 
@@ -16,25 +14,6 @@ import Control.Applicative
 import Data.Data
 import Data.Maybe
 
-data RichToken = RichToken
-    { rtkToken :: Token
-    , rtkDetails :: Maybe TokenDetails
-    }
-
-data TokenDetails
-    = RtkVar GHC.Name
-    | RtkType GHC.Name
-    | RtkBind GHC.Name
-    | RtkDecl GHC.Name
-    | RtkModule GHC.ModuleName
-    deriving (Eq)
-
-rtkName :: TokenDetails -> Either GHC.Name GHC.ModuleName
-rtkName (RtkVar name) = Left name
-rtkName (RtkType name) = Left name
-rtkName (RtkBind name) = Left name
-rtkName (RtkDecl name) = Left name
-rtkName (RtkModule name) = Right name
 
 -- | Add more detailed information to token stream using GHC API.
 enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index d927aa08b1..e206413e27 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -1,44 +1,12 @@
-module Haddock.Backends.Hyperlinker.Parser
-    ( parse
-    , Token(..), TokenType(..)
-    , Position(..), Span(..)
-    ) where
+module Haddock.Backends.Hyperlinker.Parser (parse) where
+
 
 import Data.Char
 import Data.List
 import Data.Maybe
 
-data Token = Token
-    { tkType :: TokenType
-    , tkValue :: String
-    , tkSpan :: Span
-    }
-
-data Position = Position
-    { posRow :: !Int
-    , posCol :: !Int
-    }
-
-data Span = Span
-    { spStart :: Position
-    , spEnd :: Position
-    }
-
-data TokenType
-    = TkIdentifier
-    | TkKeyword
-    | TkString
-    | TkChar
-    | TkNumber
-    | TkOperator
-    | TkGlyph
-    | TkSpecial
-    | TkSpace
-    | TkComment
-    | TkCpp
-    | TkPragma
-    | TkUnknown
-    deriving (Show, Eq)
+import Haddock.Backends.Hyperlinker.Types
+
 
 -- | Turn source code string into a stream of more descriptive tokens.
 --
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index a4d7bc2d2a..add1465bfd 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -1,8 +1,8 @@
 module Haddock.Backends.Hyperlinker.Renderer (render) where
 
+
 import Haddock.Types
-import Haddock.Backends.Hyperlinker.Parser
-import Haddock.Backends.Hyperlinker.Ast
+import Haddock.Backends.Hyperlinker.Types
 import Haddock.Backends.Hyperlinker.Utils
 
 import qualified GHC
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
new file mode 100644
index 0000000000..19cc528863
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
@@ -0,0 +1,59 @@
+module Haddock.Backends.Hyperlinker.Types where
+
+
+import qualified GHC
+
+
+data Token = Token
+    { tkType :: TokenType
+    , tkValue :: String
+    , tkSpan :: Span
+    }
+
+data Position = Position
+    { posRow :: !Int
+    , posCol :: !Int
+    }
+
+data Span = Span
+    { spStart :: Position
+    , spEnd :: Position
+    }
+
+data TokenType
+    = TkIdentifier
+    | TkKeyword
+    | TkString
+    | TkChar
+    | TkNumber
+    | TkOperator
+    | TkGlyph
+    | TkSpecial
+    | TkSpace
+    | TkComment
+    | TkCpp
+    | TkPragma
+    | TkUnknown
+    deriving (Show, Eq)
+
+
+data RichToken = RichToken
+    { rtkToken :: Token
+    , rtkDetails :: Maybe TokenDetails
+    }
+
+data TokenDetails
+    = RtkVar GHC.Name
+    | RtkType GHC.Name
+    | RtkBind GHC.Name
+    | RtkDecl GHC.Name
+    | RtkModule GHC.ModuleName
+    deriving (Eq)
+
+
+rtkName :: TokenDetails -> Either GHC.Name GHC.ModuleName
+rtkName (RtkVar name) = Left name
+rtkName (RtkType name) = Left name
+rtkName (RtkBind name) = Left name
+rtkName (RtkDecl name) = Left name
+rtkName (RtkModule name) = Right name
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
index 9ba8446dd8..db2bfc76e8 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
@@ -4,6 +4,7 @@ module Haddock.Backends.Hyperlinker.Utils
     , hypSrcModuleUrlFormat, hypSrcModuleNameUrlFormat,
     ) where
 
+
 import Haddock.Backends.Xhtml.Utils
 
 import GHC
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 59f7076fcf..0599151e3c 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -21,6 +21,7 @@ import Haddock.GhcUtils
 import Haddock.Utils
 import Haddock.Convert
 import Haddock.Interface.LexParseRn
+import Haddock.Backends.Hyperlinker.Types
 import Haddock.Backends.Hyperlinker.Ast as Hyperlinker
 import Haddock.Backends.Hyperlinker.Parser as Hyperlinker
 
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index da4b3eec14..90dbb4d4e3 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -35,7 +35,8 @@ import DynFlags (ExtensionFlag, Language)
 import OccName
 import Outputable
 import Control.Monad (ap)
-import Haddock.Backends.Hyperlinker.Ast
+
+import Haddock.Backends.Hyperlinker.Types
 
 -----------------------------------------------------------------------------
 -- * Convenient synonyms
diff --git a/haddock.cabal b/haddock.cabal
index 2a1caee7b1..8fa9f33d94 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -104,6 +104,11 @@ executable haddock
       Haddock.Backends.HaddockDB
       Haddock.Backends.Hoogle
       Haddock.Backends.Hyperlinker
+      Haddock.Backends.Hyperlinker.Ast
+      Haddock.Backends.Hyperlinker.Parser
+      Haddock.Backends.Hyperlinker.Renderer
+      Haddock.Backends.Hyperlinker.Types
+      Haddock.Backends.Hyperlinker.Utils
       Haddock.ModuleTree
       Haddock.Types
       Haddock.Doc

From 13254609062a16e010d1c5a24e571dfe98ab6f69 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 6 Jul 2015 16:52:13 +0200
Subject: [PATCH 105/109] Move source paths types to hyperlinker types module.

---
 haddock-api/src/Haddock/Backends/Hyperlinker.hs     |  2 ++
 .../src/Haddock/Backends/Hyperlinker/Renderer.hs    |  1 -
 .../src/Haddock/Backends/Hyperlinker/Types.hs       | 13 +++++++++++++
 haddock-api/src/Haddock/Types.hs                    |  9 ---------
 4 files changed, 15 insertions(+), 10 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 4b58190c60..248a8a549e 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -1,11 +1,13 @@
 module Haddock.Backends.Hyperlinker
     ( ppHyperlinkedSource
+    , module Haddock.Backends.Hyperlinker.Types
     , module Haddock.Backends.Hyperlinker.Utils
     ) where
 
 
 import Haddock.Types
 import Haddock.Backends.Hyperlinker.Renderer
+import Haddock.Backends.Hyperlinker.Types
 import Haddock.Backends.Hyperlinker.Utils
 
 import Text.XHtml hiding ((</>))
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index add1465bfd..1065897d21 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -1,7 +1,6 @@
 module Haddock.Backends.Hyperlinker.Renderer (render) where
 
 
-import Haddock.Types
 import Haddock.Backends.Hyperlinker.Types
 import Haddock.Backends.Hyperlinker.Utils
 
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
index 19cc528863..ecb51a07c0 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
@@ -3,6 +3,8 @@ module Haddock.Backends.Hyperlinker.Types where
 
 import qualified GHC
 
+import Data.Map (Map)
+
 
 data Token = Token
     { tkType :: TokenType
@@ -57,3 +59,14 @@ rtkName (RtkType name) = Left name
 rtkName (RtkBind name) = Left name
 rtkName (RtkDecl name) = Left name
 rtkName (RtkModule name) = Right name
+
+
+-- | Path for making cross-package hyperlinks in generated sources.
+--
+-- Used in 'SrcMap' to determine whether module originates in current package
+-- or in an external package.
+data SrcPath
+  = SrcExternal FilePath
+  | SrcLocal
+
+type SrcMap = Map GHC.Module SrcPath
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 90dbb4d4e3..6dd6450619 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -51,7 +51,6 @@ type SubMap        = Map Name [Name]
 type DeclMap       = Map Name [LHsDecl Name]
 type InstMap       = Map SrcSpan Name
 type FixMap        = Map Name Fixity
-type SrcMap        = Map Module SrcPath
 type DocPaths      = (FilePath, Maybe FilePath) -- paths to HTML and sources
 
 
@@ -272,14 +271,6 @@ unrenameDocForDecl (doc, fnArgsDoc) =
 -- | Type of environment used to cross-reference identifiers in the syntax.
 type LinkEnv = Map Name Module
 
--- | Path for making cross-package hyperlinks in generated sources.
---
--- Used in 'SrcMap' to determine whether module originates in current package
--- or in an external package.
-data SrcPath
-  = SrcExternal FilePath
-  | SrcLocal
-
 -- | Extends 'Name' with cross-reference information.
 data DocName
   = Documented Name Module

From bbd036ad309c95ce70affa5aa0a77a61aa5569c8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 6 Jul 2015 17:06:19 +0200
Subject: [PATCH 106/109] Add support for hyperlinking modules in import lists.

---
 haddock-api/src/Haddock.hs                    |  2 +-
 .../Haddock/Backends/Hyperlinker/Renderer.hs  | 21 ++++++++-----------
 .../src/Haddock/Backends/Hyperlinker/Types.hs | 10 ++++++---
 3 files changed, 17 insertions(+), 16 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index d4d8e3e602..350a73ead4 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -268,7 +268,7 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
       | Flag_HyperlinkedSource `elem` flags = Just hypSrcModuleUrlFormat
       | otherwise = srcModule
 
-    srcMap = Map.union
+    srcMap = mkSrcMap $ Map.union
       (Map.map SrcExternal extSrcMap)
       (Map.fromList [ (ifaceMod iface, SrcLocal) | iface <- ifaces ])
 
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 1065897d21..5037421a22 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -144,14 +144,14 @@ hyperlink srcs details = case rtkName details of
         if GHC.isInternalName name
         then internalHyperlink name
         else externalNameHyperlink srcs name
-    Right name -> externalModHyperlink name
+    Right name -> externalModHyperlink srcs name
 
 internalHyperlink :: GHC.Name -> Html -> Html
 internalHyperlink name content =
     Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ]
 
 externalNameHyperlink :: SrcMap -> GHC.Name -> Html -> Html
-externalNameHyperlink srcs name content = case Map.lookup mdl srcs of
+externalNameHyperlink (srcs, _) name content = case Map.lookup mdl srcs of
     Just SrcLocal -> Html.anchor content !
         [ Html.href $ hypSrcModuleNameUrl mdl name ]
     Just (SrcExternal path) -> Html.anchor content !
@@ -160,13 +160,10 @@ externalNameHyperlink srcs name content = case Map.lookup mdl srcs of
   where
     mdl = GHC.nameModule name
 
--- TODO: Implement module hyperlinks.
---
--- Unfortunately, 'ModuleName' is not enough to provide viable cross-package
--- hyperlink. And the problem is that GHC AST does not have other information
--- on imported modules, so for the time being, we do not provide such reference
--- either.
-externalModHyperlink :: GHC.ModuleName -> Html -> Html
-externalModHyperlink _ content =
-    content
-    --Html.anchor content ! [ Html.href $ hypSrcModuleUrl' mdl ]
+externalModHyperlink :: SrcMap -> GHC.ModuleName -> Html -> Html
+externalModHyperlink (_, srcs) name content = case Map.lookup name srcs of
+    Just SrcLocal -> Html.anchor content !
+        [ Html.href $ hypSrcModuleUrl' name ]
+    Just (SrcExternal path) -> Html.anchor content !
+        [ Html.href $ path </> hypSrcModuleUrl' name ]
+    Nothing -> content
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
index ecb51a07c0..c3954dc9b1 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
@@ -4,6 +4,7 @@ module Haddock.Backends.Hyperlinker.Types where
 import qualified GHC
 
 import Data.Map (Map)
+import qualified Data.Map as Map
 
 
 data Token = Token
@@ -66,7 +67,10 @@ rtkName (RtkModule name) = Right name
 -- Used in 'SrcMap' to determine whether module originates in current package
 -- or in an external package.
 data SrcPath
-  = SrcExternal FilePath
-  | SrcLocal
+    = SrcExternal FilePath
+    | SrcLocal
 
-type SrcMap = Map GHC.Module SrcPath
+type SrcMap = (Map GHC.Module SrcPath, Map GHC.ModuleName SrcPath)
+
+mkSrcMap :: Map GHC.Module SrcPath -> SrcMap
+mkSrcMap srcs = (srcs, Map.mapKeys GHC.moduleName srcs)

From b6e9968643bc0ab6c61289ecee7205e4d7bc421a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 6 Jul 2015 17:26:49 +0200
Subject: [PATCH 107/109] Add short documentation for hyperlinker source map
 type.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
index c3954dc9b1..5f4dbc8cc5 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs
@@ -70,6 +70,15 @@ data SrcPath
     = SrcExternal FilePath
     | SrcLocal
 
+-- | Mapping from modules to cross-package source paths.
+--
+-- This mapping is actually a pair of maps instead of just one map. The reason
+-- for this is because when hyperlinking modules in import lists we have no
+-- 'GHC.Module' available. On the other hand, we can't just use map with
+-- 'GHC.ModuleName' as indices because certain modules may have common name
+-- but originate in different packages. Hence, we use both /rich/ and /poor/
+-- versions, where the /poor/ is just projection of /rich/ one cached in pair
+-- for better performance.
 type SrcMap = (Map GHC.Module SrcPath, Map GHC.ModuleName SrcPath)
 
 mkSrcMap :: Map GHC.Module SrcPath -> SrcMap

From 0e1cad7c38ed1a771794d9332233f784a52d2c1a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 6 Jul 2015 18:07:20 +0200
Subject: [PATCH 108/109] Fix bug with module name being hyperlinked to
 `Prelude`.

---
 haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs        | 7 ++++---
 .../test/Haddock/Backends/Hyperlinker/ParserSpec.hs        | 1 +
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 28fdc3f5c9..71b7366355 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -146,7 +146,7 @@ decls (group, _, _, _) = concatMap ($ group)
 -- import lists.
 imports :: GHC.RenamedSource -> DetailsMap
 imports src@(_, imps, _, _) =
-    everything (<|>) ie src ++ map (imp . GHC.unLoc) imps
+    everything (<|>) ie src ++ mapMaybe (imp . GHC.unLoc) imps
   where
     ie term = case cast term of
         (Just (GHC.IEVar v)) -> pure $ var v
@@ -156,9 +156,10 @@ imports src@(_, imps, _, _) =
         _ -> empty
     typ (GHC.L sspan name) = (sspan, RtkType name)
     var (GHC.L sspan name) = (sspan, RtkVar name)
-    imp idecl =
+    imp idecl | not . GHC.ideclImplicit $ idecl =
         let (GHC.L sspan name) = GHC.ideclName idecl
-        in (sspan, RtkModule name)
+        in Just (sspan, RtkModule name)
+    imp _ = Nothing
 
 -- | Check whether token stream span matches GHC source span.
 --
diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
index a76bdcdc51..8cd2690e56 100644
--- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
+++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
@@ -5,6 +5,7 @@ import Test.Hspec
 import Test.QuickCheck
 
 import Haddock.Backends.Hyperlinker.Parser
+import Haddock.Backends.Hyperlinker.Types
 
 
 main :: IO ()

From d76c57b3bfade1916b83c11bdb81601990138dff Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=81ukasz=20Hanuszczak?= <lukasz.hanuszczak@gmail.com>
Date: Mon, 6 Jul 2015 18:23:47 +0200
Subject: [PATCH 109/109] Fix problem with spec build in Haddock API
 configuration.

---
 haddock-api/haddock-api.cabal | 1 +
 1 file changed, 1 insertion(+)

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 3838c3d82a..439c058cfc 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -113,6 +113,7 @@ test-suite spec
   build-depends:
       base >= 4.3 && < 4.9
     , containers
+    , ghc >= 7.10 && < 7.10.2
 
     , hspec
     , QuickCheck == 2.*