From d5b26fa7095b80adc5b9efc593ee4d6090896ad0 Mon Sep 17 00:00:00 2001
From: davve <davve@dtek.chalmers.se>
Date: Sat, 16 Sep 2006 00:16:57 +0000
Subject: Refactor PackageData creation code and start on building the doc env
propery (unfinished)
---
src/Main.hs | 99 +++++++++++++++++++++++++++++++++++--------------------------
1 file changed, 57 insertions(+), 42 deletions(-)
diff --git a/src/Main.hs b/src/Main.hs
index bea0dc5c..d8dfd55a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -22,7 +22,7 @@ import Control.Monad.Writer ( Writer, runWriter, tell )
import Data.Char ( isSpace )
import Data.IORef ( writeIORef )
import Data.List ( nub, nubBy, (\\), foldl', sortBy, foldl1, init,
- mapAccumL, find )
+ mapAccumL, find, isPrefixOf )
import Data.Maybe ( Maybe(..), isJust, isNothing, maybeToList,
listToMaybe, fromJust, catMaybes )
import System.Console.GetOpt ( getOpt, usageInfo, ArgOrder(..), OptDescr(..),
@@ -683,7 +683,7 @@ updateHTMLXRefs :: [PackageData] -> IO ()
updateHTMLXRefs packages = writeIORef html_xrefs_ref (Map.fromList mapping)
where
mapping = [ (mod, html) |
- (PackageData _ mods html) <- packages, (mod, _) <- mods ]
+ (PackageData mods _ html) <- packages, mod <- mods ]
getPrologue :: [Flag] -> IO (Maybe (HsDoc RdrName))
getPrologue flags
@@ -1139,16 +1139,17 @@ packageModules pkgInfo = map (mkModule (pkgId pkgInfo)) moduleNames
pkgId :: InstalledPackageInfo -> PackageId
pkgId = mkPackageId . package
--- | Get the ModuleInfo for each exposed module in a package
-getPackageModuleInfo :: Session -> InstalledPackageInfo ->
- IO (Maybe [(Module, ModuleInfo)])
-getPackageModuleInfo session pkgInfo = do
- mbInfos <- (flip mapM) (packageModules pkgInfo) $ \mod -> do
- mbModInfo <- getModuleInfo session mod
- case mbModInfo of
- Nothing -> return Nothing
- Just modInfo -> return (Just (mod, modInfo))
- return (sequence mbInfos)
+-- | Topologically sort a list of modules that belong to an external package,
+-- using the dependency information available in the ModIface structure for
+-- each module.
+sortPackageModules :: [Module] -> IO [Module]
+sortPackageModules = undefined
+
+-- | For each module in the list, try to retrieve a ModuleInfo structure
+moduleInfo :: Session -> [Module] -> IO (Maybe [ModuleInfo])
+moduleInfo session modules = do
+ mbModInfo <- mapM (getModuleInfo session) modules
+ return (sequence mbModInfo)
-- | Get the Haddock HTML directory path for a package
getHtml :: InstalledPackageInfo -> IO (Either String FilePath)
@@ -1158,45 +1159,66 @@ getHtml pkgInfo = case haddockHTMLs pkgInfo of
if dirExists then return (Right path) else return $
Left ("HTML directory " ++ path ++ " does not exist.")
_ -> return (Left "No Haddock documentation installed.")
-
+
data PackageData = PackageData {
- pdPackageId :: PackageId,
- pdModuleInfo :: [(Module, ModuleInfo)],
- pdHtmlPath :: FilePath
+ pdModules :: [Module],
+ pdDocEnv :: [(Name, Name)],
+ pdHtmlPath :: FilePath
}
--- | Retrieve a PackageData for a package in the session
-getPackageData :: Session -> InstalledPackageInfo ->
- IO (Either String PackageData)
-getPackageData session pkgInfo = do
+-- | Try to create a PackageData structure for a package
+getPackage :: Session -> InstalledPackageInfo -> IO (Either String PackageData)
+getPackage session pkgInfo = do
+
+ -- try to get the html path to the documentation
eHtml <- getHtml pkgInfo
- mbModInfo <- getPackageModuleInfo session pkgInfo
+
+ -- get a sorted list of the exposed modules
+ let modules = packageModules pkgInfo
+ modules' <- sortPackageModules modules
+
+ -- try to get a ModuleInfo struct for each module
+ mbModInfo <- moduleInfo session modules'
+ let toEither err = maybe (Left err) Right
let eModInfo = toEither "Could not get ModuleInfo for all exposed modules."
mbModInfo
- return $ do -- in the Either monad
+
+ -- build the PackageData structure in the Either monad
+ return $ do
html <- eHtml
modInfo <- eModInfo
return $ PackageData {
- pdPackageId = pkgId pkgInfo,
- pdModuleInfo = modInfo,
- pdHtmlPath = html
- }
- where
- toEither err = maybe (Left err) Right
+ pdModules = modules',
+ pdDocEnv = packageDocEnv modules' modInfo,
+ pdHtmlPath = html
+ }
+
+-- | Build a package doc env out of a topologically sorted list of modules
+packageDocEnv :: [Module] -> [ModuleInfo] -> [(Name, Name)]
+packageDocEnv mods infos = concatMap moduleDocEnv (zip mods infos)
+ where
+ moduleDocEnv (mod, modInfo)
+ | "GHC" `isPrefixOf` moduleString mod = []
+ | otherwise = [ (n, nameSetMod n mod) | n <- (modInfoExports modInfo) ]
--- | Retrieve a PackageData for each package in the session except for rts.
--- Print a warning on stdout if a PackageData could not be retrieved.
+-- | Try to create a PackageData for each package in the session except for
+-- rts. Print a warning on stdout if a PackageData could not be created.
getPackages :: Session -> DynFlags -> IO [PackageData]
getPackages session dynflags = do
+
+ -- get InstalledPackageInfo's for every package in the session
pkgInfos <- getExplicitPackagesAnd dynflags []
+
+ -- return a list of those packages that we could create PackageData's for
let pkgInfos' = filter notRTS pkgInfos
- liftM catMaybes (mapM getPackage pkgInfos')
+ liftM catMaybes (mapM tryGetPackage pkgInfos')
+
where
-- no better way to do this?
notRTS p = pkgName (package p) /= packageIdString rtsPackageId
- getPackage pkgInfo = do
- result <- getPackageData session pkgInfo
+ tryGetPackage pkgInfo = do
+ result <- getPackage session pkgInfo
case result of
Left err -> do
let pkgName = showPackageId (package pkgInfo)
@@ -1205,13 +1227,6 @@ getPackages session dynflags = do
return Nothing
Right pkgInfo -> return (Just pkgInfo)
+-- | Build one big doc env out of a list of packages
packagesDocEnv :: [PackageData] -> Map Name Name
-packagesDocEnv packages = Map.fromList (concatMap packageDocEnv packages)
-
-packageDocEnv :: PackageData -> [(Name, Name)]
-packageDocEnv package = concatMap moduleInfoDocEnv modInfo
- where modInfo = pdModuleInfo package
-
-moduleInfoDocEnv :: (Module, ModuleInfo) -> [(Name, Name)]
-moduleInfoDocEnv (mod, modInfo) = [ (n, nameSetMod n mod) | n <- names ]
- where names = modInfoExports modInfo
+packagesDocEnv packages = Map.fromList (concatMap pdDocEnv packages)
--
cgit v1.2.3