aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Xhtml
diff options
context:
space:
mode:
authorjpmoresmau <jp@moresmau.fr>2015-05-17 15:31:03 +0200
committerMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2015-06-12 16:03:16 +0100
commit3d11080b9f56a901593b6237d674d617a429e64a (patch)
tree4315c3a4fec5ab5a248ac6dc9802be7ee96186d4 /haddock-api/src/Haddock/Backends/Xhtml
parent5aaa14fa020da56be7fdf943f6da3310d11a3593 (diff)
Attach to instance location the name that has the same location file
Fixes #383
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs6
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Layout.hs24
2 files changed, 15 insertions, 15 deletions
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