aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Interface
diff options
context:
space:
mode:
authorDavid Waern <davve@dtek.chalmers.se>2007-11-06 00:49:21 +0000
committerDavid Waern <davve@dtek.chalmers.se>2007-11-06 00:49:21 +0000
commite05c48731b6af1a8c71c0f379cf16c7079b93fa3 (patch)
tree12ed95f57a36de8cc1c0668b20380befc17c123f /src/Haddock/Interface
parentb7b6aee89676d16ac620f0752900a3dbb74e5843 (diff)
Filter out instances with TyCons that are not exported
Diffstat (limited to 'src/Haddock/Interface')
-rw-r--r--src/Haddock/Interface/AttachInstances.hs22
1 files changed, 16 insertions, 6 deletions
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 8e81d8a6..f5140401 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -28,10 +28,13 @@ import FastString
#define FSLIT(x) (mkFastString# (x#))
-attachInstances :: [Interface] -> [Interface]
-attachInstances modules = map attach modules
+attachInstances :: [Interface] -> [Name] -> [Interface]
+attachInstances modules filterNames = map attach modules
where
- instMap = fmap (map toHsInstHead . sortImage instHead) $ collectInstances modules
+ instMap =
+ fmap (map toHsInstHead . sortImage instHead) $
+ collectInstances modules filterNames
+
attach mod = mod { ifaceExportItems = newItems }
where
newItems = map attachExport (ifaceExportItems mod)
@@ -43,6 +46,11 @@ attachInstances modules = map attach modules
attachExport otherExport = otherExport
+--------------------------------------------------------------------------------
+-- Collecting and sorting instances
+--------------------------------------------------------------------------------
+
+
-- | Simplified type for sorting types, ignoring qualification (not visible
-- in Haddock output) and unifying special tycons with normal ones.
data SimpleType = SimpleType Name [SimpleType] deriving (Eq,Ord)
@@ -50,17 +58,19 @@ data SimpleType = SimpleType Name [SimpleType] deriving (Eq,Ord)
collectInstances
:: [Interface]
+ -> [Name]
-> Map Name [([TyVar], [PredType], Class, [Type])] -- maps class/type names to instances
-collectInstances modules
+collectInstances modules filterNames
= Map.fromListWith (flip (++)) tyInstPairs `Map.union`
Map.fromListWith (flip (++)) classInstPairs
where
allInstances = concat (map ifaceInstances modules)
classInstPairs = [ (is_cls inst, [instanceHead inst]) |
- inst <- allInstances ]
+ inst <- allInstances, Just n <- nub (is_tcs inst),
+ n `elem` filterNames ]
tyInstPairs = [ (tycon, [instanceHead inst]) | inst <- allInstances,
- Just tycon <- nub (is_tcs inst) ]
+ Just tycon <- nub (is_tcs inst) ]
instHead :: ([TyVar], [PredType], Class, [Type]) -> ([Int], Name, [SimpleType])