[commit: haddock] ghc-head, wip/revert-ttg-2017-11-20, wip/ttg-2017-11-06, wip/ttg2-2017-11-10, wip/ttg3-2017-11-12, wip/ttg4-constraints-2017-11-13: fullModuleContents traverses exports in declaration order (2be7dcf)

git at git.haskell.org git at git.haskell.org
Mon Nov 20 21:12:02 UTC 2017


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

On branches: ghc-head,wip/revert-ttg-2017-11-20,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/2be7dcf62f945a765ee403f91530e43203efc948

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

commit 2be7dcf62f945a765ee403f91530e43203efc948
Author: alexbiehl <alex.biehl at gmail.com>
Date:   Tue Oct 31 22:28:34 2017 +0100

    fullModuleContents traverses exports in declaration order


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

2be7dcf62f945a765ee403f91530e43203efc948
 haddock-api/src/Haddock/Interface/Create.hs | 17 +++++++++++------
 1 file changed, 11 insertions(+), 6 deletions(-)

diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 9bf21e5..096fdda 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -38,7 +38,6 @@ import qualified Data.Map as M
 import Data.Map (Map)
 import Data.List
 import Data.Maybe
-import Data.Monoid
 import Data.Ord
 import Control.Applicative
 import Control.Exception (evaluate)
@@ -55,6 +54,7 @@ import GHC
 import HscTypes
 import Name
 import NameSet
+import NameEnv
 import Bag
 import RdrName
 import TcRnTypes
@@ -626,7 +626,7 @@ mkExportItems
   case exportList of
     Nothing      ->
       fullModuleContents is_sig modMap thisMod semMod warnings exportedNames
-        maps fixMap splices instIfaceMap dflags allExports
+        decls maps fixMap splices instIfaceMap dflags allExports
     Just exports -> liftM concat $ mapM lookupExport exports
   where
     lookupExport (IEGroup lev docStr, _)  = liftErrMsg $ do
@@ -955,6 +955,7 @@ fullModuleContents :: Bool               -- is it a signature
                    -> Module             -- semantic module
                    -> WarningMap
                    -> [Name]             -- exported names (orig)
+                   -> [LHsDecl GhcRn]    -- renamed source declarations
                    -> Maps
                    -> FixMap
                    -> [SrcSpan]          -- splice locations
@@ -963,11 +964,15 @@ fullModuleContents :: Bool               -- is it a signature
                    -> Avails
                    -> ErrMsgGhc [ExportItem GhcRn]
 fullModuleContents is_sig modMap thisMod semMod warnings exportedNames
-  maps fixMap splices instIfaceMap dflags avails =
-
-  concat <$> traverse (availExportItem is_sig modMap thisMod
+  decls maps fixMap splices instIfaceMap dflags avails = do
+  let availEnv = availsToNameEnv avails
+  (concat . concat) `fmap` (for decls $ \decl -> do
+    for (getMainDeclBinder (unLoc decl)) $ \nm -> do
+      case lookupNameEnv availEnv nm of
+        Just avail -> availExportItem is_sig modMap thisMod
                         semMod warnings exportedNames maps fixMap
-                        splices instIfaceMap dflags) avails
+                        splices instIfaceMap dflags avail
+        Nothing -> pure [])
 
 -- | 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



More information about the ghc-commits mailing list