Get rid of GhcModule and related cruft

We can get everything we need directly from TypecheckedModule.

4 files changed, 22 insertions, 81 deletions

diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs
index fbc2a7d3..0c171cbc 100644
--- a/src/Haddock/Interface.hs
+++ b/src/Haddock/Interface.hs
@@ -43,7 +43,6 @@ import Haddock.Utils
 import Control.Monad
 import Data.List
 import qualified Data.Map as Map
-import Data.Maybe
 import Distribution.Verbosity
 import System.Directory
 import System.FilePath
@@ -156,21 +155,11 @@ createIfaces verbosity flags instIfaceMap mods = do
 processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> Ghc (Maybe Interface)
 processModule verbosity modsum flags modMap instIfaceMap = do
   out verbosity verbose $ "Checking module " ++ moduleString (ms_mod modsum) ++ "..."
-  tc_mod <- loadModule =<< typecheckModule =<< parseModule modsum
+  tm <- loadModule =<< typecheckModule =<< parseModule modsum
   if not $ isBootSummary modsum
     then do
-      let filename = msHsFilePath modsum
-      let dynflags = ms_hspp_opts modsum
-      let Just renamed_src = renamedSource tc_mod
-      let ghcMod = mkGhcModule (ms_mod modsum,
-                            filename,
-                            (parsedSource tc_mod,
-                             renamed_src,
-                             typecheckedSource tc_mod,
-                             moduleInfo tc_mod))
-                            dynflags
       out verbosity verbose "Creating interface..."
-      (interface, msg) <- runWriterGhc $ createInterface ghcMod flags modMap instIfaceMap
+      (interface, msg) <- runWriterGhc $ createInterface tm flags modMap instIfaceMap
       liftIO $ mapM_ putStrLn msg
       interface' <- liftIO $ evaluate interface
       return (Just interface')
@@ -178,36 +167,6 @@ processModule verbosity modsum flags modMap instIfaceMap = do
       return Nothing
 
 
-type CheckedMod = (Module, FilePath, FullyCheckedMod)
-
-
-type FullyCheckedMod = (ParsedSource,
-                        RenamedSource,
-                        TypecheckedSource,
-                        ModuleInfo)
-
-
--- | Dig out what we want from the typechecker output
-mkGhcModule :: CheckedMod -> DynFlags -> GhcModule
-mkGhcModule (mdl, file, checkedMod) dynflags = GhcModule {
-  ghcModule         = mdl,
-  ghcFilename       = file,
-  ghcMbDocOpts      = mbOpts,
-  ghcMbDocHdr       = mbDocHdr,
-  ghcGroup          = group_,
-  ghcMbExports      = mbExports,
-  ghcExportedNames  = modInfoExports modInfo,
-  ghcDefinedNames   = map getName $ modInfoTyThings modInfo,
-  ghcNamesInScope   = fromJust $ modInfoTopLevelScope modInfo,
-  ghcInstances      = modInfoInstances modInfo,
-  ghcDynFlags       = dynflags
-}
-  where
-    mbOpts = haddockOptions dynflags
-    (group_, _, mbExports, mbDocHdr) = renamed
-    (_, renamed, _, modInfo) = checkedMod
-
-
 --------------------------------------------------------------------------------
 -- * Building of cross-linking environment  
 --------------------------------------------------------------------------------
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index c33e36cf..b6215a34 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -29,6 +29,7 @@ import Control.Monad
 import qualified Data.Traversable as Traversable
 
 import GHC hiding (flags)
+import HscTypes
 import Name
 import Bag
 import RdrName (GlobalRdrEnv)
@@ -37,41 +38,43 @@ import RdrName (GlobalRdrEnv)
 -- | Process the data in a GhcModule to produce an interface.
 -- To do this, we need access to already processed modules in the topological
 -- sort. That's what's in the interface map.
-createInterface :: GhcModule -> [Flag] -> IfaceMap -> InstIfaceMap
+createInterface :: TypecheckedModule -> [Flag] -> IfaceMap -> InstIfaceMap
                 -> ErrMsgGhc Interface
-createInterface ghcMod flags modMap instIfaceMap = do
+createInterface tm flags modMap instIfaceMap = do
 
-  let mdl    = ghcModule ghcMod
-      dflags = ghcDynFlags ghcMod
+  let ms                  = pm_mod_summary . tm_parsed_module $ tm
+      mi                  = moduleInfo tm
+      mdl                 = ms_mod ms
+      dflags              = ms_hspp_opts ms
+      instances           = modInfoInstances mi
+      exportedNames       = modInfoExports mi
+      -- XXX: confirm always a Just.
+      Just (group_, _, optExports, optDocHeader) = renamedSource tm
 
   -- The pattern-match should not fail, because createInterface is only
   -- done on loaded modules.
   Just gre <- liftGhcToErrMsgGhc $ lookupLoadedHomeModuleGRE (moduleName mdl)
 
-  opts0 <- liftErrMsg $ mkDocOpts (ghcMbDocOpts ghcMod) flags mdl
+  opts0 <- liftErrMsg $ mkDocOpts (haddockOptions dflags) flags mdl
   let opts
         | Flag_IgnoreAllExports `elem` flags = OptIgnoreExports : opts0
         | otherwise = opts0
 
+  (info, mbDoc)    <- liftErrMsg $ lexParseRnHaddockModHeader dflags gre optDocHeader
+  decls0           <- liftErrMsg $ declInfos dflags gre (topDecls group_)
 
-  (info, mbDoc)    <- liftErrMsg $ lexParseRnHaddockModHeader dflags
-                                       gre (ghcMbDocHdr ghcMod)
-  decls0           <- liftErrMsg $ declInfos dflags gre (topDecls (ghcGroup ghcMod))
-
-  let instances      = ghcInstances ghcMod
-      localInsts     = filter (nameIsLocalOrFrom mdl . getName) instances
+  let localInsts     = filter (nameIsLocalOrFrom mdl . getName) instances
       declDocs       = [ (decl, doc) | (L _ decl, (Just doc, _), _) <- decls0 ]
       instanceDocMap = mkInstanceDocMap localInsts declDocs
 
       decls         = filterOutInstances decls0
       declMap       = mkDeclMap decls
-      exports       = fmap (reverse . map unLoc) (ghcMbExports ghcMod)
+      exports       = fmap (reverse . map unLoc) optExports
       ignoreExps    = Flag_IgnoreAllExports `elem` flags
-      exportedNames = ghcExportedNames ghcMod
 
   liftErrMsg $ warnAboutFilteredDecls mdl decls0
 
-  exportItems <- mkExportItems modMap mdl gre (ghcExportedNames ghcMod) decls declMap
+  exportItems <- mkExportItems modMap mdl gre exportedNames decls declMap
                                opts exports ignoreExps instances instIfaceMap dflags
 
   let visibleNames = mkVisibleNames exportItems opts
@@ -85,7 +88,7 @@ createInterface ghcMod flags modMap instIfaceMap = do
 
   return Interface {
     ifaceMod             = mdl,
-    ifaceOrigFilename    = ghcFilename ghcMod,
+    ifaceOrigFilename    = msHsFilePath ms,
     ifaceInfo            = info,
     ifaceDoc             = mbDoc,
     ifaceRnDoc           = Nothing,
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index d862b56d..62a603ee 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -351,29 +351,6 @@ data DocOption
 
 
 -----------------------------------------------------------------------------
--- * Misc.
------------------------------------------------------------------------------
-
-
--- TODO: remove?
--- | This structure holds the module information we get from GHC's
--- type checking phase
-data GhcModule = GhcModule {
-   ghcModule         :: Module,
-   ghcFilename       :: FilePath,
-   ghcMbDocOpts      :: Maybe String,
-   ghcMbDocHdr       :: GhcDocHdr,
-   ghcGroup          :: HsGroup Name,
-   ghcMbExports      :: Maybe [LIE Name],
-   ghcExportedNames  :: [Name],
-   ghcDefinedNames   :: [Name],
-   ghcNamesInScope   :: [Name],
-   ghcInstances      :: [Instance],
-   ghcDynFlags       :: DynFlags
-}
-  
-
------------------------------------------------------------------------------
 -- * Error handling
 -----------------------------------------------------------------------------
 
diff --git a/src/Main.hs b/src/Main.hs
index 1192b1fb..22a649d2 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -146,6 +146,8 @@ main = handleTopExceptions $ do
       renderStep flags packages []
 
 
+readPackagesAndProcessModules :: [Flag] -> [String] -> IO ([(InterfaceFile, FilePath)],
+                                                           [Interface], LinkEnv)
 readPackagesAndProcessModules flags files = do
   libDir <- getGhcLibDir flags