aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface
diff options
context:
space:
mode:
authorjpmoresmau <jp@moresmau.fr>2015-01-20 18:27:16 +0100
committerMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2015-01-22 19:36:59 +0000
commit279a662adc83dba2e24bd0b99f7da9d63455f840 (patch)
tree2e5361b00bb9fbc5fe226b24fa7c58d93f9ff0e3 /haddock-api/src/Haddock/Interface
parent2c60cb0da855d76c57980298056cefe15ff4c226 (diff)
Links to source location of class instance definitions
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r--haddock-api/src/Haddock/Interface/AttachInstances.hs11
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs4
2 files changed, 8 insertions, 7 deletions
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index 1341e57f..37203d63 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -72,21 +72,22 @@ attachToExportItem expInfo iface ifaceMap instIfaceMap export =
mb_info <- getAllInfo (tcdName d)
insts <- case mb_info of
Just (_, _, cls_instances, fam_instances) ->
- let fam_insts = [ (synifyFamInst i opaque, n)
+ let fam_insts = [ (L (getSrcSpan n) $ synifyFamInst i opaque, doc)
| i <- sortBy (comparing instFam) fam_instances
- , let n = instLookup instDocMap (getName i) iface ifaceMap instIfaceMap
+ , let n = getName i
+ , let doc = instLookup instDocMap n iface ifaceMap instIfaceMap
, not $ isNameHidden expInfo (fi_fam i)
, not $ any (isTypeHidden expInfo) (fi_tys i)
, let opaque = isTypeHidden expInfo (fi_rhs i)
]
- cls_insts = [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap)
+ cls_insts = [ (L (getSrcSpan n) $ synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap)
| 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 = [ (fi, n) | (Right fi, n) <- fam_insts ]
- famInstErrs = [ errm | (Left errm, _) <- fam_insts ]
+ cleanFamInsts = [ (L l fi, n) | (L l (Right fi), n) <- fam_insts ]
+ famInstErrs = [ errm | (L _ (Left errm), _) <- fam_insts ]
in do
dfs <- getDynFlags
let mkBug = (text "haddock-bug:" <+>) . text
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 1ea212f5..7b9481fe 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -499,10 +499,10 @@ renameExportItem item = case item of
decl' <- renameLDecl decl
doc' <- renameDocForDecl doc
subs' <- mapM renameSub subs
- instances' <- forM instances $ \(inst, idoc) -> do
+ instances' <- forM instances $ \(L l inst, idoc) -> do
inst' <- renameInstHead inst
idoc' <- mapM renameDoc idoc
- return (inst', idoc')
+ return (L l inst', idoc')
fixities' <- forM fixities $ \(name, fixity) -> do
name' <- lookupRn name
return (name', fixity)