Fix #1206 by passing instance name as anchor

(cherry picked from commit 88106cb)

Author: soupi

haddock-api/src/Haddock/Backends/Xhtml/Decl.hs

@@ -634,10 +634,12 @@ ppInstances links origin instances splice unicode pkg qual
   -- force Splice = True to use line URLs
   where
     instName = getOccString origin
-    instDecl :: Int -> DocInstance DocNameI -> (SubDecl, Maybe Module, Located DocName)
+    instDecl :: Int -> DocInstance DocNameI -> (String, SubDecl, Maybe Module, Located DocName)
     instDecl no (inst, mdoc, loc, mdl) =
-        ((ppInstHead links splice unicode qual mdoc origin False no inst mdl), mdl, loc)
-
+        (instanceAnchor, mModule, mdl, loc)
+      where
+        instanceAnchor = getOccString (ihdClsName inst) <> "_" <> show no <> ":"
+        mModule = ppInstHead links splice unicode qual mdoc origin False no inst mdl
 
 ppOrphanInstances :: LinksInfo
                   -> [DocInstance DocNameI]
@@ -649,9 +651,12 @@ ppOrphanInstances links instances splice unicode pkg qual
     instOrigin :: InstHead name -> InstOrigin (IdP name)
     instOrigin inst = OriginClass (ihdClsName inst)
 
-    instDecl :: Int -> DocInstance DocNameI -> (SubDecl, Maybe Module, Located DocName)
+    instDecl :: Int -> DocInstance DocNameI -> (String, SubDecl, Maybe Module, Located DocName)
     instDecl no (inst, mdoc, loc, mdl) =
-        ((ppInstHead links splice unicode qual mdoc (instOrigin inst) True no inst Nothing), mdl, loc)
+        (instanceAnchor, mModule, mdl, loc)
+      where
+        instanceAnchor = getOccString (ihdClsName inst) <> "_" <> show no <> ":"
+        mModule = ppInstHead links splice unicode qual mdoc (instOrigin inst) True no inst Nothing
 
 
 ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification

haddock-api/src/Haddock/Backends/Xhtml/Layout.hs

@@ -153,16 +153,16 @@ subTable pkg qual decls = Just $ table << aboves (concatMap subRow decls)
 
 -- | Sub table with source information (optional).
 subTableSrc :: Maybe Package -> Qualification -> LinksInfo -> Bool
-            -> [(SubDecl, Maybe Module, Located DocName)] -> Maybe Html
+            -> [(String, SubDecl, Maybe Module, Located DocName)] -> Maybe Html
 subTableSrc _ _ _ _ [] = Nothing
 subTableSrc pkg qual lnks splice decls = Just $ table << aboves (concatMap subRow decls)
   where
-    subRow ((decl, mdoc, subs), mdl, L loc dn) =
+    subRow (instanchor, (decl, mdoc, subs), mdl, L loc dn) =
       (td ! [theclass "src clearfix"] <<
         (thespan ! [theclass "inst-left"] << decl)
         <+> linkHtml loc mdl dn
       <->
-      docElement td << fmap (docToHtml Nothing pkg qual) mdoc
+      docElement td << fmap (docToHtml (Just instanchor) pkg qual) mdoc
       )
       : map (cell . (td <<)) subs
 
@@ -201,7 +201,7 @@ subEquations pkg qual = divSubDecls "equations" "Equations" . subTable pkg qual
 subInstances :: Maybe Package -> Qualification
              -> String -- ^ Class name, used for anchor generation
              -> LinksInfo -> Bool
-             -> [(SubDecl, Maybe Module, Located DocName)] -> Html
+             -> [(String, SubDecl, Maybe Module, Located DocName)] -> Html
 subInstances pkg qual nm lnks splice = maybe noHtml wrap . instTable
   where
     wrap contents = subSection (hdr +++ collapseDetails id_ DetailsOpen (summary +++ contents))
@@ -214,7 +214,7 @@ subInstances pkg qual nm lnks splice = maybe noHtml wrap . instTable
 
 subOrphanInstances :: Maybe Package -> Qualification
                    -> LinksInfo -> Bool
-                   -> [(SubDecl, Maybe Module, Located DocName)] -> Html
+                   -> [(String, SubDecl, Maybe Module, Located DocName)] -> Html
 subOrphanInstances pkg qual lnks splice  = maybe noHtml wrap . instTable
   where
     wrap = ((h1 << "Orphan instances") +++)