aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Interface
diff options
context:
space:
mode:
authorNiklas Haas <git@nand.wakku.to>2014-03-13 08:53:41 +0100
committerMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2014-03-13 19:18:10 +0000
commiteaf0a0b51f452398f3c64882a334f90b920df794 (patch)
treee007ca9b2a8748ab9aeb135e813f91b673884f2f /src/Haddock/Interface
parent64175d6ade5717b7e0c7fa0a122d16cae6779031 (diff)
Display minimal complete definitions for type classes
This corresponds to the new {-# MINIMAL #-} pragma present in GHC 7.8+. I also cleaned up some of the places in which ExportDecl is used to make adding fields easier in the future. Lots of test cases have been updated since they now render with minimality information.
Diffstat (limited to 'src/Haddock/Interface')
-rw-r--r--src/Haddock/Interface/Create.hs41
-rw-r--r--src/Haddock/Interface/Rename.hs1
2 files changed, 27 insertions, 15 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index aef2cd8f..f1262d9f 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -437,7 +437,7 @@ filterClasses decls = [ if isClassD d then (L loc (filterClass d), doc) else x
| x@(L loc d, doc) <- decls ]
where
filterClass (TyClD c) =
- TyClD $ c { tcdSigs = filter isVanillaLSig $ tcdSigs c }
+ TyClD $ c { tcdSigs = filter (liftA2 (||) isVanillaLSig isMinimalLSig) $ tcdSigs c }
filterClass _ = error "expected TyClD"
@@ -547,17 +547,23 @@ mkExportItems
return []
-- normal case
- | otherwise -> return [ mkExportDecl t newDecl docs_ ]
- where
- -- A single signature might refer to many names, but we
- -- create an export item for a single name only. So we
- -- modify the signature to contain only that single name.
- newDecl = case decl of
- (L loc (SigD sig)) ->
- L loc . SigD . fromJust $ filterSigNames (== t) sig
- -- fromJust is safe since we already checked in guards
- -- that 't' is a name declared in this declaration.
- _ -> decl
+ | otherwise -> case decl of
+ -- A single signature might refer to many names, but we
+ -- create an export item for a single name only. So we
+ -- modify the signature to contain only that single name.
+ L loc (SigD sig) ->
+ -- fromJust is safe since we already checked in guards
+ -- that 't' is a name declared in this declaration.
+ let newDecl = L loc . SigD . fromJust $ filterSigNames (== t) sig
+ in return [ mkExportDecl t newDecl docs_ ]
+
+ L loc (TyClD cl@ClassDecl{}) -> do
+ mdef <- liftGhcToErrMsgGhc $ minimalDef t
+ let sig = maybeToList $ fmap (noLoc . MinimalSig . fmap noLoc) mdef
+ return [ mkExportDecl t
+ (L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) docs_ ]
+
+ _ -> return [ mkExportDecl t decl docs_ ]
-- Declaration from another package
([], _) -> do
@@ -737,15 +743,20 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
| Just name <- M.lookup (getInstLoc d) instMap =
let (doc, subs) = lookupDocs name warnings docMap argMap subMap in
return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+ mkExportItem (L l (TyClD cl@ClassDecl{ tcdLName = L _ name, tcdSigs = sigs })) = do
+ mdef <- liftGhcToErrMsgGhc $ minimalDef name
+ let sig = maybeToList $ fmap (noLoc . MinimalSig . fmap noLoc) mdef
+ expDecl (L l (TyClD cl { tcdSigs = sig ++ sigs })) l name
mkExportItem decl@(L l d)
- | name:_ <- getMainDeclBinder d =
- let (doc, subs) = lookupDocs name warnings docMap argMap subMap in
- return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+ | name:_ <- getMainDeclBinder d = expDecl decl l name
| otherwise = return Nothing
fixities name subs = [ (n,f) | n <- name : map fst subs
, Just f <- [M.lookup n fixMap] ]
+ expDecl decl l name = return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+ where (doc, subs) = lookupDocs name warnings docMap argMap subMap
+
-- | Sometimes the declaration we want to export is not the "main" declaration:
-- it might be an individual record selector or a class method. In these
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 4160f4f7..748e0210 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -414,6 +414,7 @@ renameSig sig = case sig of
FixSig (FixitySig lname fixity) -> do
lname' <- renameL lname
return $ FixSig (FixitySig lname' fixity)
+ MinimalSig s -> MinimalSig <$> traverse renameL s
-- we have filtered out all other kinds of signatures in Interface.Create
_ -> error "expected TypeSig"