From 279a662adc83dba2e24bd0b99f7da9d63455f840 Mon Sep 17 00:00:00 2001
From: jpmoresmau <jp@moresmau.fr>
Date: Tue, 20 Jan 2015 18:27:16 +0100
Subject: Links to source location of class instance definitions

---
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 44 +++++++++++++++++-------
 1 file changed, 32 insertions(+), 12 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index b2c60534..923958a7 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -148,6 +148,20 @@ subTable qual decls = Just $ table << aboves (concatMap subRow decls)
        docElement td << fmap (docToHtml Nothing qual) mdoc)
       : map (cell . (td <<)) subs
 
+-- | Sub table with source information (optional).
+subTableSrc :: Qualification -> LinksInfo -> Bool -> DocName -> [(SubDecl,SrcSpan)] -> Maybe Html
+subTableSrc _ _  _ _ [] = Nothing
+subTableSrc qual lnks splice dn decls = Just $ table << aboves (concatMap subRow decls)
+  where
+    subRow ((decl, mdoc, subs),loc) =
+      (td ! [theclass "src"] << decl
+      <+> linkHtml loc
+      <->
+      docElement td << fmap (docToHtml Nothing qual) mdoc
+      )
+      : map (cell . (td <<)) subs
+    linkHtml loc@(RealSrcSpan _) = links lnks loc splice dn
+    linkHtml _ = noHtml
 
 subBlock :: [Html] -> Maybe Html
 subBlock [] = Nothing
@@ -174,13 +188,15 @@ subEquations :: Qualification -> [SubDecl] -> Html
 subEquations qual = divSubDecls "equations" "Equations" . subTable qual
 
 
+-- | Generate sub table for instance declarations, with source
 subInstances :: Qualification
              -> String -- ^ Class name, used for anchor generation
-             -> [SubDecl] -> Html
-subInstances qual nm = maybe noHtml wrap . instTable
+             -> LinksInfo -> Bool -> DocName
+             -> [(SubDecl,SrcSpan)] -> Html
+subInstances qual nm lnks splice dn = maybe noHtml wrap . instTable
   where
     wrap = (subSection <<) . (subCaption +++)
-    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTable qual
+    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTableSrc qual lnks splice dn
     subSection = thediv ! [theclass "subs instances"]
     subCaption = paragraph ! collapseControl id_ True "caption" << "Instances"
     id_ = makeAnchorId $ "i:" ++ nm
@@ -200,12 +216,19 @@ declElem = paragraph ! [theclass "src"]
 -- a box for top level documented names
 -- it adds a source and wiki link at the right hand side of the box
 topDeclElem :: LinksInfo -> SrcSpan -> Bool -> [DocName] -> Html -> Html
-topDeclElem ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice names html =
-    declElem << (html <+> srcLink <+> wikiLink)
+topDeclElem lnks loc splice names html =
+    declElem << (html <+> (links lnks loc splice $ head names))
+        -- FIXME: is it ok to simply take the first name?
+
+-- | Adds a source and wiki link at the right hand side of the box.
+-- Name must be documented, otherwise we wouldn't get here.
+links :: LinksInfo -> SrcSpan -> Bool -> DocName -> Html
+links ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice (Documented n mdl) =
+   (srcLink <+> wikiLink)
   where srcLink = let nameUrl = Map.lookup origPkg sourceMap
                       lineUrl = Map.lookup origPkg lineMap
                       mUrl | splice    = lineUrl
-                                         -- Use the lineUrl as a backup
+                                        -- Use the lineUrl as a backup
                            | otherwise = maybe lineUrl Just nameUrl in
           case mUrl of
             Nothing  -> noHtml
@@ -227,10 +250,7 @@ topDeclElem ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice names htm
         origMod = nameModule n
         origPkg = modulePackageKey origMod
 
-        -- Name must be documented, otherwise we wouldn't get here
-        Documented n mdl = head names
-        -- FIXME: is it ok to simply take the first name?
-
         fname = case loc of
-                RealSrcSpan l -> unpackFS (srcSpanFile l)
-                UnhelpfulSpan _ -> error "topDeclElem UnhelpfulSpan"
+          RealSrcSpan l -> unpackFS (srcSpanFile l)
+          UnhelpfulSpan _ -> error "links: UnhelpfulSpan"
+links _ _ _ _ = noHtml
-- 
cgit v1.2.3


From 3d11080b9f56a901593b6237d674d617a429e64a Mon Sep 17 00:00:00 2001
From: jpmoresmau <jp@moresmau.fr>
Date: Sun, 17 May 2015 15:31:03 +0200
Subject: Attach to instance location the name that has the same location file

Fixes #383
---
 haddock-api/src/Haddock/Backends/LaTeX.hs          |  4 ++--
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs     |  6 +++---
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs   | 24 +++++++++++-----------
 .../src/Haddock/Interface/AttachInstances.hs       | 23 ++++++++++++++++-----
 haddock-api/src/Haddock/Interface/Rename.hs        |  5 +++--
 haddock-api/src/Haddock/Types.hs                   |  2 +-
 6 files changed, 39 insertions(+), 25 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 125e1b3a..2febd5ae 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -544,14 +544,14 @@ ppDocInstances unicode (i : rest)
     (is, rest') = spanWith isUndocdInstance rest
 
 isUndocdInstance :: DocInstance a -> Maybe (InstHead a)
-isUndocdInstance (L _ i,Nothing) = Just i
+isUndocdInstance (i,Nothing,_) = Just i
 isUndocdInstance _ = Nothing
 
 -- | Print a possibly commented instance. The instance header is printed inside
 -- an 'argBox'. The comment is printed to the right of the box in normal comment
 -- style.
 ppDocInstance :: Bool -> DocInstance DocName -> LaTeX
-ppDocInstance unicode (L _ instHead, doc) =
+ppDocInstance unicode (instHead, doc, _) =
   declWithDoc (ppInstDecl unicode instHead) (fmap docToLaTeX $ fmap _doc doc)
 
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 952d29c9..df85a492 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -497,12 +497,12 @@ ppClassDecl _ _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppS
 
 ppInstances :: LinksInfo -> [DocInstance DocName] -> DocName -> Unicode -> Qualification -> Html
 ppInstances links instances baseName unicode qual
-  = subInstances qual instName links True baseName (map instDecl instances)
+  = subInstances qual instName links True (map instDecl instances)
   -- force Splice = True to use line URLs
   where
     instName = getOccString $ getName baseName
-    instDecl :: DocInstance DocName -> (SubDecl,SrcSpan)
-    instDecl (L l inst, maybeDoc) = ((instHead inst, maybeDoc, []),l)
+    instDecl :: DocInstance DocName -> (SubDecl,Located DocName)
+    instDecl (inst, maybeDoc,l) = ((instHead inst, maybeDoc, []),l)
     instHead (n, ks, ts, ClassInst cs) = ppContextNoLocs cs unicode qual
         <+> ppAppNameTypes n ks ts unicode qual
     instHead (n, ks, ts, TypeInst rhs) = keyword "type"
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 923958a7..e686d648 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -44,7 +44,6 @@ import Haddock.Backends.Xhtml.Types
 import Haddock.Backends.Xhtml.Utils
 import Haddock.Types
 import Haddock.Utils (makeAnchorId)
-
 import qualified Data.Map as Map
 import Text.XHtml hiding ( name, title, p, quote )
 
@@ -148,20 +147,21 @@ subTable qual decls = Just $ table << aboves (concatMap subRow decls)
        docElement td << fmap (docToHtml Nothing qual) mdoc)
       : map (cell . (td <<)) subs
 
+
 -- | Sub table with source information (optional).
-subTableSrc :: Qualification -> LinksInfo -> Bool -> DocName -> [(SubDecl,SrcSpan)] -> Maybe Html
-subTableSrc _ _  _ _ [] = Nothing
-subTableSrc qual lnks splice dn decls = Just $ table << aboves (concatMap subRow decls)
+subTableSrc :: Qualification -> LinksInfo -> Bool -> [(SubDecl,Located DocName)] -> Maybe Html
+subTableSrc _ _  _ [] = Nothing
+subTableSrc qual lnks splice decls = Just $ table << aboves (concatMap subRow decls)
   where
-    subRow ((decl, mdoc, subs),loc) =
+    subRow ((decl, mdoc, subs),L loc dn) =
       (td ! [theclass "src"] << decl
-      <+> linkHtml loc
+      <+> linkHtml loc dn
       <->
       docElement td << fmap (docToHtml Nothing qual) mdoc
       )
       : map (cell . (td <<)) subs
-    linkHtml loc@(RealSrcSpan _) = links lnks loc splice dn
-    linkHtml _ = noHtml
+    linkHtml loc@(RealSrcSpan _) dn = links lnks loc splice dn
+    linkHtml _ _ = noHtml
 
 subBlock :: [Html] -> Maybe Html
 subBlock [] = Nothing
@@ -191,12 +191,12 @@ subEquations qual = divSubDecls "equations" "Equations" . subTable qual
 -- | Generate sub table for instance declarations, with source
 subInstances :: Qualification
              -> String -- ^ Class name, used for anchor generation
-             -> LinksInfo -> Bool -> DocName
-             -> [(SubDecl,SrcSpan)] -> Html
-subInstances qual nm lnks splice dn = maybe noHtml wrap . instTable
+             -> LinksInfo -> Bool
+             -> [(SubDecl,Located DocName)] -> Html
+subInstances qual nm lnks splice = maybe noHtml wrap . instTable
   where
     wrap = (subSection <<) . (subCaption +++)
-    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTableSrc qual lnks splice dn
+    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTableSrc qual lnks splice
     subSection = thediv ! [theclass "subs instances"]
     subCaption = paragraph ! collapseControl id_ True "caption" << "Instances"
     id_ = makeAnchorId $ "i:" ++ nm
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index 37203d63..fc530507 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -38,6 +38,7 @@ import MonadUtils (liftIO)
 import Name
 import Outputable (text, sep, (<+>))
 import PrelNames
+import SrcLoc
 import TcRnDriver (tcRnGetInfo)
 import TcType (tcSplitSigmaTy)
 import TyCon
@@ -68,11 +69,11 @@ attachToExportItem :: ExportInfo -> Interface -> IfaceMap -> InstIfaceMap
                    -> Ghc (ExportItem Name)
 attachToExportItem expInfo iface ifaceMap instIfaceMap export =
   case attachFixities export of
-    e@ExportDecl { expItemDecl = L _ (TyClD d) } -> do
+    e@ExportDecl { expItemDecl = L eSpan (TyClD d) } -> do
       mb_info <- getAllInfo (tcdName d)
       insts <- case mb_info of
         Just (_, _, cls_instances, fam_instances) ->
-          let fam_insts = [ (L (getSrcSpan n) $ synifyFamInst i opaque, doc)
+          let fam_insts = [ (synifyFamInst i opaque, doc,spanNameE n (synifyFamInst i opaque) (L eSpan (tcdName d)) )
                           | i <- sortBy (comparing instFam) fam_instances
                           , let n = getName i
                           , let doc = instLookup instDocMap n iface ifaceMap instIfaceMap
@@ -80,14 +81,14 @@ attachToExportItem expInfo iface ifaceMap instIfaceMap export =
                           , not $ any (isTypeHidden expInfo) (fi_tys i)
                           , let opaque = isTypeHidden expInfo (fi_rhs i)
                           ]
-              cls_insts = [ (L (getSrcSpan n) $ synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap)
+              cls_insts = [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap, spanName n (synifyInstHead i) (L eSpan (tcdName d)))
                           | let is = [ (instanceHead' i, getName i) | i <- cls_instances ]
                           , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is
                           , not $ isInstanceHidden expInfo cls tys
                           ]
               -- fam_insts but with failing type fams filtered out
-              cleanFamInsts = [ (L l fi, n) | (L l (Right fi), n) <- fam_insts ]
-              famInstErrs = [ errm | (L _ (Left errm), _) <- fam_insts ]
+              cleanFamInsts = [ (fi, n, L l r) | (Right fi, n, L l (Right r)) <- fam_insts ]
+              famInstErrs = [ errm | (Left errm, _, _) <- fam_insts ]
           in do
             dfs <- getDynFlags
             let mkBug = (text "haddock-bug:" <+>) . text
@@ -106,6 +107,18 @@ attachToExportItem expInfo iface ifaceMap instIfaceMap export =
       ] }
 
     attachFixities e = e
+    -- spanName: attach the location to the name that is the same file as the instance location
+    spanName s (clsn,_,_,_) (L instL instn) =
+        let s1 = getSrcSpan s
+            sn = if srcSpanFileName_maybe s1 == srcSpanFileName_maybe instL
+                    then instn
+                    else clsn
+        in L (getSrcSpan s) sn
+    -- spanName on Either
+    spanNameE s (Left e) _ =  L (getSrcSpan s) (Left e)
+    spanNameE s (Right ok) linst =
+      let L l r = spanName s ok linst
+      in L l (Right r)
 
 
 instLookup :: (InstalledInterface -> Map.Map Name a) -> Name
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index ee9f8fc4..1a559764 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -498,10 +498,11 @@ renameExportItem item = case item of
     decl' <- renameLDecl decl
     doc'  <- renameDocForDecl doc
     subs' <- mapM renameSub subs
-    instances' <- forM instances $ \(L l inst, idoc) -> do
+    instances' <- forM instances $ \(inst, idoc, L l n) -> do
       inst' <- renameInstHead inst
+      n' <- rename n
       idoc' <- mapM renameDoc idoc
-      return (L l inst', idoc')
+      return (inst', idoc',L l n')
     fixities' <- forM fixities $ \(name, fixity) -> do
       name' <- lookupRn name
       return (name', fixity)
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index f9cf6e17..14995098 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -300,7 +300,7 @@ instance OutputableBndr a => Outputable (InstType a) where
   ppr (DataInst  a) = text "DataInst"  <+> ppr a
 
 -- | An instance head that may have documentation and a source location.
-type DocInstance name = (Located (InstHead name), Maybe (MDoc name))
+type DocInstance name = (InstHead name, Maybe (MDoc name), Located name)
 
 -- | The head of an instance. Consists of a class name, a list of kind
 -- parameters, a list of type parameters and an instance type
-- 
cgit v1.2.3


From a476b251e363b3b0ed30c75cf72a19fc275d6440 Mon Sep 17 00:00:00 2001
From: Phil Ruffwind <rf@rufflewind.com>
Date: Fri, 12 Jun 2015 12:59:24 -0400
Subject: Fix alignment of Source links in instance table in Firefox

Due to a Firefox bug [1], a combination of 'whitespace: nowrap' on the
parent element with 'float: right' on the inner element can cause the
floated element to be displaced downwards for no apparent reason.

To work around this, the left side is wrapped in its own <span> and set
to 'float: left'.  As a precautionary measure to prevent the parent
element from collapsing entirely, we also add the classic "clearfix"
hack.  The latter is not strictly needed but it helps prevent bugs if
the layout is altered again in the future.

Fixes #384.

Remark: line 159 of src/Haddock/Backends/Xhtml/Layout.hs was indented to
        prevent confusion over the operator precedence of (<+>) vs (<<).

[1]: https://bugzilla.mozilla.org/show_bug.cgi?id=488725
---
 haddock-api/resources/html/Ocean.std-theme/ocean.css | 13 +++++++++++++
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs     |  5 +++--
 2 files changed, 16 insertions(+), 2 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css
index ef652a21..1110b407 100644
--- a/haddock-api/resources/html/Ocean.std-theme/ocean.css
+++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css
@@ -416,6 +416,14 @@ div#style-menu-holder {
   margin-top: 0.8em;
 }
 
+.clearfix:after {
+  clear: both;
+  content: " ";
+  display: block;
+  height: 0;
+  visibility: hidden;
+}
+
 .subs dl {
   margin: 0;
 }
@@ -455,6 +463,11 @@ div#style-menu-holder {
   margin-left: 1em;
 }
 
+/* Workaround for bug in Firefox (issue #384) */
+.inst-left {
+  float: left;
+}
+
 .top p.src {
   border-top: 1px solid #ccc;
 }
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index e686d648..914a7a7e 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -154,8 +154,9 @@ subTableSrc _ _  _ [] = Nothing
 subTableSrc qual lnks splice decls = Just $ table << aboves (concatMap subRow decls)
   where
     subRow ((decl, mdoc, subs),L loc dn) =
-      (td ! [theclass "src"] << decl
-      <+> linkHtml loc dn
+      (td ! [theclass "src clearfix"] <<
+        (thespan ! [theclass "inst-left"] << decl)
+        <+> linkHtml loc dn
       <->
       docElement td << fmap (docToHtml Nothing qual) mdoc
       )
-- 
cgit v1.2.3


From e190efe089a0bd038c7de41c1c52ef580e52712c Mon Sep 17 00:00:00 2001
From: Phil Ruffwind <rf@rufflewind.com>
Date: Sun, 14 Jun 2015 22:47:13 -0400
Subject: Fix typo in Haddock.Backends.Xhtml.Layout: divSynposis -> divSynopsis

Closes #408
---
 haddock-api/src/Haddock/Backends/Xhtml.hs        | 2 +-
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 6 +++---
 2 files changed, 4 insertions(+), 4 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 90cb9fa4..e5e4db3f 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -546,7 +546,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
     synopsis
       | no_doc_at_all = noHtml
       | otherwise
-      = divSynposis $
+      = divSynopsis $
             paragraph ! collapseControl "syn" False "caption" << "Synopsis" +++
             shortDeclList (
                 mapMaybe (processExport True linksInfo unicode qual) exports
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 914a7a7e..e79c2c3d 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -14,7 +14,7 @@ module Haddock.Backends.Xhtml.Layout (
   miniBody,
 
   divPackageHeader, divContent, divModuleHeader, divFooter,
-  divTableOfContents, divDescription, divSynposis, divInterface,
+  divTableOfContents, divDescription, divSynopsis, divInterface,
   divIndex, divAlphabet, divModuleList,
 
   sectionName,
@@ -76,7 +76,7 @@ nonEmptySectionName c
 
 
 divPackageHeader, divContent, divModuleHeader, divFooter,
-  divTableOfContents, divDescription, divSynposis, divInterface,
+  divTableOfContents, divDescription, divSynopsis, divInterface,
   divIndex, divAlphabet, divModuleList
     :: Html -> Html
 
@@ -86,7 +86,7 @@ divModuleHeader     = sectionDiv "module-header"
 divFooter           = sectionDiv "footer"
 divTableOfContents  = sectionDiv "table-of-contents"
 divDescription      = sectionDiv "description"
-divSynposis         = sectionDiv "synopsis"
+divSynopsis         = sectionDiv "synopsis"
 divInterface        = sectionDiv "interface"
 divIndex            = sectionDiv "index"
 divAlphabet         = sectionDiv "alphabet"
-- 
cgit v1.2.3


From c274363d5d868c838c382a52428c667090514f86 Mon Sep 17 00:00:00 2001
From: Phil Ruffwind <rf@rufflewind.com>
Date: Mon, 27 Jul 2015 05:58:58 -0400
Subject: Fix record field alignment when name is too long

Change <dl> to <ul> and use display:table rather than floats to layout
the record fields.  This avoids bug #301 that occurs whenever the field
name gets too long.

Slight aesthetic change: the entire cell of the field's source code is
now shaded gray rather than just the area where text exists.

Fixes #301. Closes #421
---
 .../resources/html/Ocean.std-theme/ocean.css       | 29 +++++++++++-----------
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs   | 10 +++-----
 2 files changed, 19 insertions(+), 20 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css
index 1cc55cb6..9ad9f9d2 100644
--- a/haddock-api/resources/html/Ocean.std-theme/ocean.css
+++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css
@@ -427,30 +427,31 @@ div#style-menu-holder {
   visibility: hidden;
 }
 
-.subs dl {
+.subs ul {
+  list-style: none;
+  display: table;
   margin: 0;
 }
 
-.subs dt {
-  float: left;
-  clear: left;
-  display: block;
+.subs ul li {
+  display: table-row;
+}
+
+.subs ul li dfn {
+  display: table-cell;
+  font-style: normal;
+  font-weight: bold;
   margin: 1px 0;
+  white-space: nowrap;
 }
 
-.subs dd {
-  float: right;
-  width: 90%;
-  display: block;
+.subs ul li > .doc {
+  display: table-cell;
   padding-left: 0.5em;
   margin-bottom: 0.5em;
 }
 
-.subs dd.empty {
-  display: none;
-}
-
-.subs dd p {
+.subs ul li > .doc p {
   margin: 0;
 }
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index e79c2c3d..4714c1b6 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -127,14 +127,12 @@ divSubDecls cssClass captionName = maybe noHtml wrap
 
 subDlist :: Qualification -> [SubDecl] -> Maybe Html
 subDlist _ [] = Nothing
-subDlist qual decls = Just $ dlist << map subEntry decls +++ clearDiv
+subDlist qual decls = Just $ ulist << map subEntry decls
   where
     subEntry (decl, mdoc, subs) =
-      dterm ! [theclass "src"] << decl
-      +++
-      docElement ddef << (fmap (docToHtml Nothing qual) mdoc +++ subs)
-
-    clearDiv = thediv ! [ theclass "clear" ] << noHtml
+      li <<
+        (define ! [theclass "src"] << decl +++
+         docElement thediv << (fmap (docToHtml Nothing qual) mdoc +++ subs))
 
 
 subTable :: Qualification -> [SubDecl] -> Maybe Html
-- 
cgit v1.2.3


From 05f35d7defbf702e27211628e26a738fa97ecde8 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Wed, 15 Jul 2015 14:27:28 +0200
Subject: Add expandable method section for each class instance declaration.

---
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs   | 52 ++++++++++++++++--------
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 16 +++++++-
 2 files changed, 50 insertions(+), 18 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index afbbaad1..22b34228 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -269,7 +269,7 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode
       = subEquations qual $ map (ppTyFamEqn . unLoc) eqns
 
       | otherwise
-      = ppInstances links instances Nothing docname unicode qual
+      = ppInstances links instances Nothing docname splice unicode qual
 
     -- Individual equation of a closed type family
     ppTyFamEqn TyFamEqn { tfe_tycon = n, tfe_rhs = rhs
@@ -493,37 +493,54 @@ ppClassDecl summary links instances fixities loc d subdocs
     ppMinimal p (Or fs) = wrap $ foldr1 (\a b -> a+++" | "+++b) $ map (ppMinimal False) fs
       where wrap | p = parens | otherwise = id
 
-    instancesBit = ppInstances links instances (Just sigs) nm unicode qual
+    instancesBit = ppInstances links instances (Just sigs) nm splice unicode qual
 
 ppClassDecl _ _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
 
 
 ppInstances :: LinksInfo
             -> [DocInstance DocName] -> Maybe [Sig DocName] -> DocName
-            -> Unicode -> Qualification
+            -> Splice -> Unicode -> Qualification
             -> Html
-ppInstances links instances _ baseName unicode qual
-  = subInstances qual instName links True (map instDecl instances)
+ppInstances links instances msigs baseName splice unicode qual
+  = subInstances qual instName links True (zipWith instDecl [1..] instances)
   -- force Splice = True to use line URLs
   where
     instName = getOccString $ getName baseName
-    instDecl :: DocInstance DocName -> (SubDecl,Located DocName)
-    instDecl (inst, maybeDoc,l) =
-        ((ppInstHead links unicode qual inst, maybeDoc, []),l)
+    instDecl :: Int -> DocInstance DocName -> (SubDecl,Located DocName)
+    instDecl iid (inst, maybeDoc,l) =
+        ((ppInstHead links splice unicode qual msigs iid inst, maybeDoc, []),l)
 
-ppInstHead :: LinksInfo -> Unicode -> Qualification
-           -> InstHead DocName
+
+ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
+           -> Maybe [Sig DocName] -> Int -> InstHead DocName
            -> Html
-ppInstHead _ unicode qual (InstHead {..}) = case ihdInstType of
-    ClassInst cs -> ppContextNoLocs cs unicode qual <+> typ
-    TypeInst rhs -> keyword "type" <+> typ
-        <+> maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs
-    DataInst dd -> keyword "data" <+> typ
-        <+> ppShortDataDecl False True dd unicode qual
+ppInstHead links splice unicode qual msigs iid (InstHead {..}) =
+    case ihdInstType of
+        ClassInst cs | Just sigs <- msigs ->
+            subClsInstance (nameStr ++ "-" ++ show iid) hdr (mets sigs)
+          where
+            hdr = ppContextNoLocs cs unicode qual <+> typ
+            mets = ppInstanceSigs links splice unicode qual
+            nameStr = occNameString . nameOccName $ getName ihdClsName
+        ClassInst cs -> ppContextNoLocs cs unicode qual <+> typ
+        TypeInst rhs -> keyword "type" <+> typ
+            <+> maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs
+        DataInst dd -> keyword "data" <+> typ
+            <+> ppShortDataDecl False True dd unicode qual
   where
     typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode qual
 
 
+ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
+              -> [Sig DocName]
+              -> [Html]
+ppInstanceSigs links splice unicode qual sigs = do
+    TypeSig lnames (L sspan typ) _ <- sigs
+    let names = map unLoc lnames
+    return $ ppFunSig False links sspan noDocForDecl names typ [] splice unicode qual
+
+
 lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
 lookupAnySubdoc n = fromMaybe noDocForDecl . lookup n
 
@@ -593,7 +610,8 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl
                                      (map unLoc (con_names (unLoc c)))) fixities
       ]
 
-    instancesBit = ppInstances links instances Nothing docname unicode qual
+    instancesBit = ppInstances links instances Nothing docname
+        splice unicode qual
 
 
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 4714c1b6..188b4243 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -31,7 +31,7 @@ module Haddock.Backends.Xhtml.Layout (
   subConstructors,
   subEquations,
   subFields,
-  subInstances,
+  subInstances, subClsInstance,
   subMethods,
   subMinimal,
 
@@ -200,6 +200,20 @@ subInstances qual nm lnks splice = maybe noHtml wrap . instTable
     subCaption = paragraph ! collapseControl id_ True "caption" << "Instances"
     id_ = makeAnchorId $ "i:" ++ nm
 
+
+-- | Generate class instance div with specialized methods.
+subClsInstance :: String -- ^ Section unique id
+               -> Html -- ^ Header contents (instance name and type)
+               -> [Html] -- ^ Method contents (pretty-printed signatures)
+               -> Html
+subClsInstance sid hdr mets =
+    hdrDiv <+> methodDiv
+  where
+    anchorId = makeAnchorId $ "i:" ++ sid
+    hdrDiv = thediv ! collapseControl anchorId False "instance" << hdr
+    methodDiv = thediv ! collapseSection anchorId False [] << subMethods mets
+
+
 subMethods :: [Html] -> Html
 subMethods = divSubDecls "methods" "Methods" . subBlock
 
-- 
cgit v1.2.3


From b4a82b390e3b6d7d5f1c10c42c4e36d5d7cf667b Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Tue, 21 Jul 2015 13:43:48 +0200
Subject: Make specialized signatures refer to original signature declaration.

---
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs   | 11 +++++++++--
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs |  2 +-
 2 files changed, 10 insertions(+), 3 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 176180ad..b3e1db81 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -223,6 +223,14 @@ ppTyName :: Name -> Html
 ppTyName = ppName Prefix
 
 
+ppSimpleSig :: Unicode -> Qualification -> [DocName] -> HsType DocName -> Html
+ppSimpleSig unicode qual names typ =
+    ppTypeSig True occNames ppTyp unicode
+  where
+    ppTyp = ppType unicode qual typ
+    occNames = map getOccName names
+
+
 --------------------------------------------------------------------------------
 -- * Type families
 --------------------------------------------------------------------------------
@@ -542,8 +550,7 @@ ppInstanceSigs links splice unicode qual (InstSpec {..}) (InstHead {..}) = do
     TypeSig lnames (L sspan typ) _ <- ispecSigs
     let names = map unLoc lnames
     let typ' = rename' . sugar $ specializeTyVarBndrs ispecTyVars ihdTypes typ
-    return $ ppFunSig False links sspan noDocForDecl names typ' []
-        splice unicode qual
+    return $ ppSimpleSig unicode qual names typ'
   where
     fv = foldr Set.union Set.empty . map freeVariables $ ihdTypes
     rename' = rename fv
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 188b4243..d971b0e5 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -211,7 +211,7 @@ subClsInstance sid hdr mets =
   where
     anchorId = makeAnchorId $ "i:" ++ sid
     hdrDiv = thediv ! collapseControl anchorId False "instance" << hdr
-    methodDiv = thediv ! collapseSection anchorId False [] << subMethods mets
+    methodDiv = thediv ! collapseSection anchorId False [] << subBlock mets
 
 
 subMethods :: [Html] -> Html
-- 
cgit v1.2.3


From f0edea1969cdc06d0299c606debf533d7ece77f0 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Tue, 21 Jul 2015 19:22:30 +0200
Subject: Improve placement of instance methods expander button.

---
 haddock-api/resources/html/Ocean.std-theme/ocean.css | 14 ++++++++++----
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs     |  6 +++---
 2 files changed, 13 insertions(+), 7 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css
index 9ad9f9d2..428040bc 100644
--- a/haddock-api/resources/html/Ocean.std-theme/ocean.css
+++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css
@@ -146,15 +146,21 @@ ul.links li a {
   background-image: url(plus.gif);
   background-repeat: no-repeat;
 }
-p.caption.collapser,
-p.caption.expander {
-  background-position: 0 0.4em;
-}
 .collapser, .expander {
   padding-left: 14px;
   margin-left: -14px;
   cursor: pointer;
 }
+p.caption.collapser,
+p.caption.expander {
+  background-position: 0 0.4em;
+}
+
+.instance.collapser, .instance.expander {
+  margin-left: 0px;
+  background-position: left center;
+}
+
 
 pre {
   padding: 0.25em;
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index d971b0e5..460cc6d7 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -207,11 +207,11 @@ subClsInstance :: String -- ^ Section unique id
                -> [Html] -- ^ Method contents (pretty-printed signatures)
                -> Html
 subClsInstance sid hdr mets =
-    hdrDiv <+> methodDiv
+    (hdrDiv << hdr) <+> (methodDiv << subBlock mets)
   where
     anchorId = makeAnchorId $ "i:" ++ sid
-    hdrDiv = thediv ! collapseControl anchorId False "instance" << hdr
-    methodDiv = thediv ! collapseSection anchorId False [] << subBlock mets
+    hdrDiv = thediv ! collapseControl anchorId False "instance"
+    methodDiv = thediv ! collapseSection anchorId False "methods"
 
 
 subMethods :: [Html] -> Html
-- 
cgit v1.2.3


From f0a5efd72072b37a2150efd281eb158033e67585 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Tue, 28 Jul 2015 23:34:03 +0200
Subject: Split instance subsection layout method to top-level declarations.

---
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 27 +++++++++++++++++++-----
 1 file changed, 22 insertions(+), 5 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 460cc6d7..da03985e 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -206,12 +206,29 @@ subClsInstance :: String -- ^ Section unique id
                -> Html -- ^ Header contents (instance name and type)
                -> [Html] -- ^ Method contents (pretty-printed signatures)
                -> Html
-subClsInstance sid hdr mets =
-    (hdrDiv << hdr) <+> (methodDiv << subBlock mets)
+subClsInstance iid hdr mets = subInstHead iid hdr <+> subInstMethods iid mets
+
+
+subInstHead :: String -- ^ Instance unique id (for anchor generation)
+            -> Html -- ^ Header content (instance name and type)
+            -> Html
+subInstHead iid hdr =
+    expander << hdr
   where
-    anchorId = makeAnchorId $ "i:" ++ sid
-    hdrDiv = thediv ! collapseControl anchorId False "instance"
-    methodDiv = thediv ! collapseSection anchorId False "methods"
+    expander = thediv ! collapseControl (instAnchorId iid) False "instance"
+
+
+subInstMethods :: String -- ^ Instance unique id (for anchor generation)
+               -> [Html] -- ^ Method contents (pretty-printed signatures)
+               -> Html
+subInstMethods iid mets =
+    section << subBlock mets
+  where
+    section = thediv ! collapseSection (instAnchorId iid) False "methods"
+
+
+instAnchorId :: String -> String
+instAnchorId iid = makeAnchorId $ "i:" ++ iid
 
 
 subMethods :: [Html] -> Html
-- 
cgit v1.2.3


From 88df578a8573908d665d4597c4c619c29055a277 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Tue, 28 Jul 2015 23:58:13 +0200
Subject: Rearrange layout of instance methods in generated documentation.

---
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs   | 39 ++++++++++++++++--------
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs |  2 +-
 2 files changed, 27 insertions(+), 14 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index a9f38c14..abcf3eaf 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -525,26 +525,39 @@ ppInstances links origin instances baseName splice unicode qual
   where
     instName = getOccString $ getName baseName
     instDecl :: Int -> DocInstance DocName -> (SubDecl,Located DocName)
-    instDecl no (inst, maybeDoc,l) =
-        ((ppInstHead links splice unicode qual origin no inst, maybeDoc, []),l)
+    instDecl no (inst, mdoc, loc) =
+        ((ppInstHead links splice unicode qual mdoc origin no inst), loc)
 
 
 ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
-           -> InstOrigin -> Int -> InstHead DocName
-           -> Html
-ppInstHead links splice unicode qual origin no (InstHead {..}) =
+           -> Maybe (MDoc DocName) -> InstOrigin -> Int -> InstHead DocName
+           -> SubDecl
+ppInstHead links splice unicode qual mdoc origin no (InstHead {..}) =
     case ihdInstType of
         ClassInst { .. } ->
-            subClsInstance iid hdr mets
+            ( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual <+> typ
+            , mdoc
+            , [subInstMethods iid sigs]
+            )
           where
-            hdr = ppContextNoLocs clsiCtx unicode qual <+> typ
-            mets = ppInstanceSigs links splice unicode qual
-                clsiTyVars ihdTypes clsiSigs
             iid = instanceId origin no ihdClsName
-        TypeInst rhs -> keyword "type" <+> typ
-            <+> maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs
-        DataInst dd -> keyword "data" <+> typ
-            <+> ppShortDataDecl False True dd unicode qual
+            sigs = ppInstanceSigs links splice unicode qual
+                clsiTyVars ihdTypes clsiSigs
+        TypeInst rhs ->
+            (ptype, mdoc, [])
+          where
+            ptype = mconcat
+                [ keyword "type"
+                , typ
+                , maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs
+                ]
+        DataInst dd ->
+            (pdata, mdoc, [])
+          where
+            pdata = mconcat
+                [ keyword "data" <+> typ
+                , ppShortDataDecl False True dd unicode qual
+                ]
   where
     typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode qual
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index da03985e..0b09e220 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -31,7 +31,7 @@ module Haddock.Backends.Xhtml.Layout (
   subConstructors,
   subEquations,
   subFields,
-  subInstances, subClsInstance,
+  subInstances, subClsInstance, subInstHead, subInstMethods,
   subMethods,
   subMinimal,
 
-- 
cgit v1.2.3


From 17e6df0835457035c7837e6d3f149bb3d448e5d7 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Wed, 29 Jul 2015 00:01:56 +0200
Subject: Get rid of no longer used layout method.

---
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 12 ++----------
 1 file changed, 2 insertions(+), 10 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 0b09e220..a1c54c99 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -31,7 +31,7 @@ module Haddock.Backends.Xhtml.Layout (
   subConstructors,
   subEquations,
   subFields,
-  subInstances, subClsInstance, subInstHead, subInstMethods,
+  subInstances, subInstHead, subInstMethods,
   subMethods,
   subMinimal,
 
@@ -200,15 +200,7 @@ subInstances qual nm lnks splice = maybe noHtml wrap . instTable
     subCaption = paragraph ! collapseControl id_ True "caption" << "Instances"
     id_ = makeAnchorId $ "i:" ++ nm
 
-
--- | Generate class instance div with specialized methods.
-subClsInstance :: String -- ^ Section unique id
-               -> Html -- ^ Header contents (instance name and type)
-               -> [Html] -- ^ Method contents (pretty-printed signatures)
-               -> Html
-subClsInstance iid hdr mets = subInstHead iid hdr <+> subInstMethods iid mets
-
-
+ 
 subInstHead :: String -- ^ Instance unique id (for anchor generation)
             -> Html -- ^ Header content (instance name and type)
             -> Html
-- 
cgit v1.2.3


From 467b07ecf9b22e3492b014dbae64f2f7d9b73f02 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Wed, 29 Jul 2015 00:23:36 +0200
Subject: Attach section title to the instance methods block.

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

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index a1c54c99..117f8fc8 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -214,7 +214,7 @@ subInstMethods :: String -- ^ Instance unique id (for anchor generation)
                -> [Html] -- ^ Method contents (pretty-printed signatures)
                -> Html
 subInstMethods iid mets =
-    section << subBlock mets
+    section << subMethods mets
   where
     section = thediv ! collapseSection (instAnchorId iid) False "methods"
 
-- 
cgit v1.2.3


From 73f4a18d0b29dd209a5f1172c8ed662be11d5690 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Wed, 29 Jul 2015 12:25:54 +0200
Subject: Make instance details section contain associated types information.

---
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs   | 13 ++++++++++++-
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 11 ++++++-----
 2 files changed, 18 insertions(+), 6 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index abcf3eaf..6fb36e29 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -537,12 +537,14 @@ ppInstHead links splice unicode qual mdoc origin no (InstHead {..}) =
         ClassInst { .. } ->
             ( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual <+> typ
             , mdoc
-            , [subInstMethods iid sigs]
+            , [subInstDetails iid ats sigs]
             )
           where
             iid = instanceId origin no ihdClsName
             sigs = ppInstanceSigs links splice unicode qual
                 clsiTyVars ihdTypes clsiSigs
+            ats = ppInstanceAssocTys links splice unicode qual
+                clsiAssocTys
         TypeInst rhs ->
             (ptype, mdoc, [])
           where
@@ -562,6 +564,15 @@ ppInstHead links splice unicode qual mdoc origin no (InstHead {..}) =
     typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode qual
 
 
+ppInstanceAssocTys :: LinksInfo -> Splice -> Unicode -> Qualification
+                   -> [FamilyDecl DocName]
+                   -> [Html]
+ppInstanceAssocTys links splice unicode qual =
+    map ppTyFam'
+  where
+    ppTyFam' fam = ppTyFamHeader False True fam unicode qual
+
+
 ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
               -> LHsTyVarBndrs DocName -> [HsType DocName] -> [Sig DocName]
               -> [Html]
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 117f8fc8..074b6801 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -31,7 +31,7 @@ module Haddock.Backends.Xhtml.Layout (
   subConstructors,
   subEquations,
   subFields,
-  subInstances, subInstHead, subInstMethods,
+  subInstances, subInstHead, subInstDetails,
   subMethods,
   subMinimal,
 
@@ -210,13 +210,14 @@ subInstHead iid hdr =
     expander = thediv ! collapseControl (instAnchorId iid) False "instance"
 
 
-subInstMethods :: String -- ^ Instance unique id (for anchor generation)
+subInstDetails :: String -- ^ Instance unique id (for anchor generation)
+               -> [Html] -- ^ Associated type contents
                -> [Html] -- ^ Method contents (pretty-printed signatures)
                -> Html
-subInstMethods iid mets =
-    section << subMethods mets
+subInstDetails iid ats mets =
+    section << (subAssociatedTypes ats <+> subMethods mets)
   where
-    section = thediv ! collapseSection (instAnchorId iid) False "methods"
+    section = thediv ! collapseSection (instAnchorId iid) False "inst-details"
 
 
 instAnchorId :: String -> String
-- 
cgit v1.2.3


From c537853ff7574a6bf3c3c94fa9db52aa23a5859f Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Mon, 3 Aug 2015 15:29:35 +0200
Subject: Fix issue with instance expander hijacking type hyperlink click.

---
 haddock-api/resources/html/Ocean.std-theme/ocean.css | 2 ++
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs     | 4 ++--
 2 files changed, 4 insertions(+), 2 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css
index 428040bc..139335ac 100644
--- a/haddock-api/resources/html/Ocean.std-theme/ocean.css
+++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css
@@ -159,6 +159,8 @@ p.caption.expander {
 .instance.collapser, .instance.expander {
   margin-left: 0px;
   background-position: left center;
+  min-width: 9px;
+  min-height: 9px;
 }
 
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 074b6801..d624a1d0 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -205,9 +205,9 @@ subInstHead :: String -- ^ Instance unique id (for anchor generation)
             -> Html -- ^ Header content (instance name and type)
             -> Html
 subInstHead iid hdr =
-    expander << hdr
+    expander noHtml <+> hdr
   where
-    expander = thediv ! collapseControl (instAnchorId iid) False "instance"
+    expander = thespan ! collapseControl (instAnchorId iid) False "instance"
 
 
 subInstDetails :: String -- ^ Instance unique id (for anchor generation)
-- 
cgit v1.2.3


From 319acdd0c70d21c517aa09b3e35f87e9bc01ad8c Mon Sep 17 00:00:00 2001
From: "Edward Z. Yang" <ezyang@cs.stanford.edu>
Date: Sun, 11 Oct 2015 11:31:11 -0700
Subject: s/PackageKey/UnitId/g and s/packageKey/unitId/g

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
---
 haddock-api/src/Haddock.hs                       |  6 +++---
 haddock-api/src/Haddock/Backends/Xhtml.hs        |  2 +-
 haddock-api/src/Haddock/Backends/Xhtml/Layout.hs |  2 +-
 haddock-api/src/Haddock/Backends/Xhtml/Types.hs  |  2 +-
 haddock-api/src/Haddock/Interface/Create.hs      | 10 +++++-----
 haddock-api/src/Haddock/InterfaceFile.hs         | 13 ++++++++-----
 haddock-api/src/Haddock/ModuleTree.hs            |  6 +++---
 7 files changed, 22 insertions(+), 19 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index b87c4cf5..ef873500 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -255,8 +255,8 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
     allVisibleIfaces = [ i | i <- allIfaces, OptHide `notElem` instOptions i ]
 
     pkgMod           = ifaceMod (head ifaces)
-    pkgKey           = modulePackageKey pkgMod
-    pkgStr           = Just (packageKeyString pkgKey)
+    pkgKey           = moduleUnitId pkgMod
+    pkgStr           = Just (unitIdString pkgKey)
     pkgNameVer       = modulePackageInfo dflags flags pkgMod
 
     (srcBase, srcModule, srcEntity, srcLEntity) = sourceUrls flags
@@ -353,7 +353,7 @@ modulePackageInfo dflags flags modu =
     cmdline <|> pkgDb
   where
     cmdline = (,) <$> optPackageName flags <*> optPackageVersion flags
-    pkgDb = (\pkg -> (packageName pkg, packageVersion pkg)) <$> lookupPackage dflags (modulePackageKey modu)
+    pkgDb = (\pkg -> (packageName pkg, packageVersion pkg)) <$> lookupPackage dflags (moduleUnitId modu)
 
 
 -------------------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index e5e4db3f..a1e4f94d 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -304,7 +304,7 @@ mkNode qual ss p (Node s leaf pkg srcPkg short ts) =
 
     htmlModule = thespan ! modAttrs << (cBtn +++
       if leaf
-        then ppModule (mkModule (stringToPackageKey (fromMaybe "" pkg))
+        then ppModule (mkModule (stringToUnitId (fromMaybe "" pkg))
                                        (mkModuleName mdl))
         else toHtml s
       )
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index d624a1d0..d24ed9c4 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -271,7 +271,7 @@ links ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice (Documented n m
         -- TODO: do something about type instances. They will point to
         -- the module defining the type family, which is wrong.
         origMod = nameModule n
-        origPkg = modulePackageKey origMod
+        origPkg = moduleUnitId origMod
 
         fname = case loc of
           RealSrcSpan l -> unpackFS (srcSpanFile l)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Types.hs b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs
index 3d1db887..d1561791 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Types.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs
@@ -23,7 +23,7 @@ import GHC
 
 
 -- the base, module and entity URLs for the source code and wiki links.
-type SourceURLs = (Maybe FilePath, Maybe FilePath, Map PackageKey FilePath, Map PackageKey FilePath)
+type SourceURLs = (Maybe FilePath, Maybe FilePath, Map UnitId FilePath, Map UnitId FilePath)
 type WikiURLs = (Maybe FilePath, Maybe FilePath, Maybe FilePath)
 
 
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 169dad7a..b0a4d621 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -166,7 +166,7 @@ mkAliasMap dflags mRenamedSource =
         alias <- ideclAs impDecl
         return $
           (lookupModuleDyn dflags
-             (fmap Module.fsToPackageKey $
+             (fmap Module.fsToUnitId $
               fmap sl_fs $ ideclPkgQual impDecl)
              (case ideclName impDecl of SrcLoc.L _ name -> name),
            alias))
@@ -174,13 +174,13 @@ mkAliasMap dflags mRenamedSource =
 
 -- similar to GHC.lookupModule
 lookupModuleDyn ::
-  DynFlags -> Maybe PackageKey -> ModuleName -> Module
+  DynFlags -> Maybe UnitId -> ModuleName -> Module
 lookupModuleDyn _ (Just pkgId) mdlName =
   Module.mkModule pkgId mdlName
 lookupModuleDyn dflags Nothing mdlName =
   case Packages.lookupModuleInAllPackages dflags mdlName of
     (m,_):_ -> m
-    [] -> Module.mkModule Module.mainPackageKey mdlName
+    [] -> Module.mkModule Module.mainUnitId mdlName
 
 
 -------------------------------------------------------------------------------
@@ -704,8 +704,8 @@ moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfa
                     "documentation for exported module: " ++ pretty dflags expMod]
             return []
   where
-    m = mkModule packageKey expMod
-    packageKey = modulePackageKey thisMod
+    m = mkModule unitId expMod
+    unitId = moduleUnitId thisMod
 
 
 -- Note [1]:
diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs
index 4f4218c9..73185092 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(..), ifModule, ifPackageKey,
+  InterfaceFile(..), ifUnitId, ifModule,
   readInterfaceFile, nameCacheFromGhc, freshNameCache, NameCacheAccessor,
   writeInterfaceFile, binaryInterfaceVersion, binaryInterfaceVersionCompatibility
 ) where
@@ -57,8 +57,11 @@ ifModule if_ =
     [] -> error "empty InterfaceFile"
     iface:_ -> instMod iface
 
-ifPackageKey :: InterfaceFile -> PackageKey
-ifPackageKey = modulePackageKey . ifModule
+ifUnitId :: InterfaceFile -> UnitId
+ifUnitId if_ =
+  case ifInstalledIfaces if_ of
+    [] -> error "empty InterfaceFile"
+    iface:_ -> moduleUnitId $ instMod iface
 
 
 binaryInterfaceMagic :: Word32
@@ -312,7 +315,7 @@ getSymbolTable bh namecache = do
   return (namecache', arr)
 
 
-type OnDiskName = (PackageKey, ModuleName, OccName)
+type OnDiskName = (UnitId, ModuleName, OccName)
 
 
 fromOnDiskName
@@ -342,7 +345,7 @@ fromOnDiskName _ nc (pid, mod_name, occ) =
 serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
 serialiseName bh name _ = do
   let modu = nameModule name
-  put_ bh (modulePackageKey modu, moduleName modu, nameOccName name)
+  put_ bh (moduleUnitId modu, moduleName modu, nameOccName name)
 
 
 -------------------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/ModuleTree.hs b/haddock-api/src/Haddock/ModuleTree.hs
index 2f731214..e6cf8201 100644
--- a/haddock-api/src/Haddock/ModuleTree.hs
+++ b/haddock-api/src/Haddock/ModuleTree.hs
@@ -15,7 +15,7 @@ module Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where
 import Haddock.Types ( MDoc )
 
 import GHC           ( Name )
-import Module        ( Module, moduleNameString, moduleName, modulePackageKey, packageKeyString )
+import Module        ( Module, moduleNameString, moduleName, moduleUnitId, unitIdString )
 import DynFlags      ( DynFlags )
 import Packages      ( lookupPackage )
 import PackageConfig ( sourcePackageIdString )
@@ -28,10 +28,10 @@ mkModuleTree :: DynFlags -> Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree
 mkModuleTree dflags showPkgs mods =
   foldr fn [] [ (splitModule mdl, modPkg mdl, modSrcPkg mdl, short) | (mdl, short) <- mods ]
   where
-    modPkg mod_ | showPkgs = Just (packageKeyString (modulePackageKey mod_))
+    modPkg mod_ | showPkgs = Just (unitIdString (moduleUnitId mod_))
                 | otherwise = Nothing
     modSrcPkg mod_ | showPkgs = fmap sourcePackageIdString
-                                     (lookupPackage dflags (modulePackageKey mod_))
+                                     (lookupPackage dflags (moduleUnitId mod_))
                    | otherwise = Nothing
     fn (mod_,pkg,srcPkg,short) = addToTrees mod_ pkg srcPkg short
 
-- 
cgit v1.2.3