From eaf0a0b51f452398f3c64882a334f90b920df794 Mon Sep 17 00:00:00 2001
From: Niklas Haas <git@nand.wakku.to>
Date: Thu, 13 Mar 2014 08:53:41 +0100
Subject: 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.
---
 src/Haddock/Interface/Create.hs | 41 ++++++++++++++++++++++++++---------------
 src/Haddock/Interface/Rename.hs |  1 +
 2 files changed, 27 insertions(+), 15 deletions(-)

(limited to 'src/Haddock/Interface')

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"
 
-- 
cgit v1.2.3