diff options
author | Niklas Haas <git@nand.wakku.to> | 2014-03-13 08:53:41 +0100 |
---|---|---|
committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2014-03-13 19:18:10 +0000 |
commit | eaf0a0b51f452398f3c64882a334f90b920df794 (patch) | |
tree | e007ca9b2a8748ab9aeb135e813f91b673884f2f /src/Haddock/Interface | |
parent | 64175d6ade5717b7e0c7fa0a122d16cae6779031 (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.hs | 41 | ||||
-rw-r--r-- | src/Haddock/Interface/Rename.hs | 1 |
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" |