[commit: haddock] ghc-head, ghc-head1, haddock-quick, ie_avails, wip/new-tree-one-param, wip/revert-ttg-2017-11-20, wip/ttg-2017-10-13, wip/ttg-2017-10-31, wip/ttg-2017-11-06, wip/ttg2-2017-11-10, wip/ttg3-2017-11-12, wip/ttg4-constraints-2017-11-13: Better Backpack support with signature merging. (6cc832d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branches: ghc-head,ghc-head1,haddock-quick,ie_avails,wip/new-tree-one-param,wip/revert-ttg-2017-11-20,wip/ttg-2017-10-13,wip/ttg-2017-10-31,wip/ttg-2017-11-06,wip/ttg2-2017-11-10,wip/ttg3-2017-11-12,wip/ttg4-constraints-2017-11-13
Link       : http://git.haskell.org/haddock.git/commitdiff/6cc832dfb1de6088a4abcaae62b25a7e944d55c3

>---------------------------------------------------------------

commit 6cc832dfb1de6088a4abcaae62b25a7e944d55c3
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date:   Tue Mar 14 03:53:49 2017 -0700

    Better Backpack support with signature merging.
    
    When we merge signatures, we gain exports that don't
    necessarily have a source-level declaration corresponding
    to them.  This meant Haddock dropped them.
    
    There are two big limitations:
    
    * If there's no export list, we won't report inherited
      signatures.
    
    * If the type has a subordinate, the current hiDecl
      implementation doesn't reconstitute them.
    
    These are probably worth fixing eventually, but this gets
    us to minimum viable functionality.
    
    Signed-off-by: Edward Z. Yang <ezyang at cs.stanford.edu>


>---------------------------------------------------------------

6cc832dfb1de6088a4abcaae62b25a7e944d55c3
 haddock-api/src/Haddock/Interface/Create.hs | 46 +++++++++++++++++++++--------
 1 file changed, 34 insertions(+), 12 deletions(-)

diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 9700543..cd46831 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -71,6 +71,7 @@ createInterface tm flags modMap instIfaceMap = do
       !safety        = modInfoSafe mi
       mdl            = ms_mod ms
       sem_mdl        = tcg_semantic_mod (fst (tm_internals_ tm))
+      is_sig         = ms_hsc_src ms == HsigFile
       dflags         = ms_hspp_opts ms
       !instances     = modInfoInstances mi
       !fam_instances = md_fam_insts md
@@ -117,7 +118,7 @@ createInterface tm flags modMap instIfaceMap = do
 
   -- The MAIN functionality: compute the export items which will
   -- each be the actual documentation of this module.
-  exportItems <- mkExportItems modMap mdl sem_mdl allWarnings gre exportedNames decls
+  exportItems <- mkExportItems is_sig modMap mdl sem_mdl allWarnings gre exportedNames decls
                    maps fixMap splices exports instIfaceMap dflags
 
   let !visibleNames = mkVisibleNames maps exportItems opts
@@ -143,7 +144,7 @@ createInterface tm flags modMap instIfaceMap = do
 
   return $! Interface {
     ifaceMod             = mdl
-  , ifaceIsSig           = Module.isHoleModule sem_mdl
+  , ifaceIsSig           = is_sig
   , ifaceOrigFilename    = msHsFilePath ms
   , ifaceInfo            = info
   , ifaceDoc             = Documentation mbDoc modWarn
@@ -525,7 +526,8 @@ collectDocs = go Nothing []
 -- We create the export items even if the module is hidden, since they
 -- might be useful when creating the export items for other modules.
 mkExportItems
-  :: IfaceMap
+  :: Bool               -- is it a signature
+  -> IfaceMap
   -> Module             -- this module
   -> Module             -- semantic module
   -> WarningMap
@@ -540,7 +542,7 @@ mkExportItems
   -> DynFlags
   -> ErrMsgGhc [ExportItem Name]
 mkExportItems
-  modMap thisMod semMod warnings gre exportedNames decls
+  is_sig modMap thisMod semMod warnings gre exportedNames decls
   maps@(docMap, argMap, subMap, declMap, instMap) fixMap splices optExports instIfaceMap dflags =
   case optExports of
     Nothing -> fullModuleContents dflags warnings gre maps fixMap splices decls
@@ -569,8 +571,9 @@ mkExportItems
         Just doc -> return . ExportDoc $ processDocStringParas dflags gre doc
 
     declWith :: Name -> ErrMsgGhc [ ExportItem Name ]
-    declWith t =
-      case findDecl t of
+    declWith t = do
+      r <- findDecl t
+      case r of
         ([L l (ValD _)], (doc, _)) -> do
           -- Top-level binding without type signature
           export <- hiValExportItem dflags t l doc (l `elem` splices) $ M.lookup t fixMap
@@ -649,13 +652,32 @@ mkExportItems
     isExported = (`elem` exportedNames)
 
 
-    findDecl :: Name -> ([LHsDecl Name], (DocForDecl Name, [(Name, DocForDecl Name)]))
+    findDecl :: Name -> ErrMsgGhc ([LHsDecl Name], (DocForDecl Name, [(Name, DocForDecl Name)]))
     findDecl n
-      | m == semMod, Just ds <- M.lookup n declMap =
-          (ds, lookupDocs n warnings docMap argMap subMap)
-      | Just iface <- M.lookup (semToIdMod (moduleUnitId thisMod) m) modMap, Just ds <- M.lookup n (ifaceDeclMap iface) =
-          (ds, lookupDocs n warnings (ifaceDocMap iface) (ifaceArgMap iface) (ifaceSubMap iface))
-      | otherwise = ([], (noDocForDecl, []))
+      | m == semMod =
+          case M.lookup n declMap of
+            Just ds -> return (ds, lookupDocs n warnings docMap argMap subMap)
+            Nothing
+              | is_sig -> do
+                -- OK, so it wasn't in the local declaration map.  It could
+                -- have been inherited from a signature.  Reconstitute it
+                -- from the type.
+                mb_r <- hiDecl dflags n
+                case mb_r of
+                    Nothing -> return ([], (noDocForDecl, []))
+                    -- TODO: If we try harder, we might be able to find
+                    -- a Haddock!  Look in the Haddocks for each thing in
+                    -- requirementContext (pkgState)
+                    Just decl -> return ([decl], (noDocForDecl, []))
+              | otherwise ->
+                return ([], (noDocForDecl, []))
+      | Just iface <- M.lookup (semToIdMod (moduleUnitId thisMod) m) modMap
+      , Just ds <- M.lookup n (ifaceDeclMap iface) =
+          return (ds, lookupDocs n warnings
+                            (ifaceDocMap iface)
+                            (ifaceArgMap iface)
+                            (ifaceSubMap iface))
+      | otherwise = return ([], (noDocForDecl, []))
       where
         m = nameModule n