Show where instances are defined (#748)

* Indicate source module of instances

Above instance, we now also display a link to the module where the
instance was defined. This is sometimes helpful in figuring out
what to import.

* Source module for type/data families too

* Remove parens

* Accept tests

2 files changed, 17 insertions, 13 deletions

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 6e733373..d92bdd3a 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -566,8 +566,8 @@ ppInstances links origin instances splice unicode qual
   where
     instName = getOccString origin
     instDecl :: Int -> DocInstance DocNameI -> (SubDecl,Located DocName)
-    instDecl no (inst, mdoc, loc) =
-        ((ppInstHead links splice unicode qual mdoc origin False no inst), loc)
+    instDecl no (inst, mdoc, loc, mdl) =
+        ((ppInstHead links splice unicode qual mdoc origin False no inst mdl), loc)
 
 
 ppOrphanInstances :: LinksInfo
@@ -581,8 +581,8 @@ ppOrphanInstances links instances splice unicode qual
     instOrigin inst = OriginClass (ihdClsName inst)
 
     instDecl :: Int -> DocInstance DocNameI -> (SubDecl,Located DocName)
-    instDecl no (inst, mdoc, loc) =
-        ((ppInstHead links splice unicode qual mdoc (instOrigin inst) True no inst), loc)
+    instDecl no (inst, mdoc, loc, mdl) =
+        ((ppInstHead links splice unicode qual mdoc (instOrigin inst) True no inst mdl), loc)
 
 
 ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
@@ -591,13 +591,14 @@ ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
            -> Bool -- ^ Is instance orphan
            -> Int  -- ^ Normal
            -> InstHead DocNameI
+           -> Maybe Module
            -> SubDecl
-ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
+ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) mdl =
     case ihdInstType of
         ClassInst { .. } ->
             ( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual HideEmptyContexts <+> typ
             , mdoc
-            , [subInstDetails iid ats sigs]
+            , [subInstDetails iid ats sigs mname]
             )
           where
             sigs = ppInstanceSigs links splice unicode qual clsiSigs
@@ -605,7 +606,7 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
         TypeInst rhs ->
             ( subInstHead iid ptype
             , mdoc
-            , [subFamInstDetails iid prhs]
+            , [subFamInstDetails iid prhs mname]
             )
           where
             ptype = keyword "type" <+> typ
@@ -614,11 +615,12 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
         DataInst dd ->
             ( subInstHead iid pdata
             , mdoc
-            , [subFamInstDetails iid pdecl])
+            , [subFamInstDetails iid pdecl mname])
           where
             pdata = keyword "data" <+> typ
             pdecl = pdata <+> ppShortDataDecl False True dd [] unicode qual
   where
+    mname = maybe noHtml (\m -> toHtml "Defined in" <+> ppModule m) mdl
     iid = instanceId origin no orphan ihd
     typ = ppAppNameTypes ihdClsName ihdTypes unicode qual
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index e020b909..217ca2af 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -47,7 +47,7 @@ import Haddock.Backends.Xhtml.Utils
 import Haddock.Types
 import Haddock.Utils (makeAnchorId, nameAnchorId)
 import qualified Data.Map as Map
-import Text.XHtml hiding ( name, title, p, quote )
+import Text.XHtml hiding ( name, title, quote )
 
 import FastString            ( unpackFS )
 import GHC
@@ -228,15 +228,17 @@ subInstHead iid hdr =
 subInstDetails :: String -- ^ Instance unique id (for anchor generation)
                -> [Html] -- ^ Associated type contents
                -> [Html] -- ^ Method contents (pretty-printed signatures)
+               -> Html   -- ^ Source module
                -> Html
-subInstDetails iid ats mets =
-    subInstSection iid << (subAssociatedTypes ats <+> subMethods mets)
+subInstDetails iid ats mets mdl =
+    subInstSection iid << (p mdl <+> subAssociatedTypes ats <+> subMethods mets)
 
 subFamInstDetails :: String -- ^ Instance unique id (for anchor generation)
                   -> Html   -- ^ Type or data family instance
+                  -> Html   -- ^ Source module TODO: use this
                   -> Html
-subFamInstDetails iid fi =
-    subInstSection iid << thediv ! [theclass "src"] << fi
+subFamInstDetails iid fi mdl =
+    subInstSection iid << (p mdl <+> (thediv ! [theclass "src"] << fi))
 
 subInstSection :: String -- ^ Instance unique id (for anchor generation)
                -> Html