hdocs 0.5.0.2 → 0.5.1.0

raw patch · 3 files changed

+57/−42 lines, 3 files

Files

• hdocs.cabal +1/−1
• src/HDocs/Haddock.hs +15/−4
• src/HDocs/Module.hs +41/−37

@@ -1,5 +1,5 @@ name:                hdocs
-version:             0.5.0.2
+version:             0.5.1.0
 synopsis:            Haskell docs tool
 description:
   Tool and library to get docs for installed packages and source files.

@@ -1,6 +1,6 @@ module HDocs.Haddock (
 	-- * Documentation functions
-	readInstalledDocs,
+	readInstalledDocsF, readInstalledDocs,
 	readHaddock,
 	readSources, readSources_, readSource, readSourcesGhc, readSourceGhc,
 
@@ -9,7 +9,7 @@ 	interfaceDocs,	
 
 	-- * Utility functions
-	haddockFiles,
+	haddockFilesF, haddockFiles,
 	readInstalledInterfaces, readPackageInterfaces,
 	lookupDoc, lookupNameDoc,
 
@@ -32,6 +32,7 @@ import Documentation.Haddock
 import Documentation.Haddock.Types (_doc)
 
+import DynFlags (DynFlags)
 import Exception (gtry)
 import GHC (Ghc)
 import Module
@@ -42,6 +43,12 @@ import HDocs.Ghc.Compat
 
 -- | Read all installed docs
+readInstalledDocsF :: DynFlags -> ExceptT String IO (Map String ModuleDocMap)
+readInstalledDocsF df = do
+	fs <- haddockFilesF df
+	liftM M.unions $ forM fs $ \f -> (readHaddock f) `mplus` (return M.empty)
+
+-- | Read all installed docs
 readInstalledDocs :: [String] -> ExceptT String IO (Map String ModuleDocMap)
 readInstalledDocs opts = do
 	fs <- haddockFiles opts
@@ -88,11 +95,15 @@ interfaceDocs = stringize . (ifaceMod &&& (fmap _doc . ifaceDocMap))
 
 -- | Get list of haddock files in package db
-haddockFiles :: [String] -> ExceptT String IO [FilePath]
-haddockFiles opts = ExceptT $ withInitializedPackages opts $ return . maybe
+haddockFilesF :: DynFlags -> ExceptT String IO [FilePath]
+haddockFilesF = ExceptT . return . maybe
 	(Left "Package database empty")
 	(Right . concatMap haddockInterfaces) .
 	pkgDatabase
+
+-- | Get list of haddock files in package db
+haddockFiles :: [String] -> ExceptT String IO [FilePath]
+haddockFiles opts = ExceptT $ withInitializedPackages opts (runExceptT . haddockFilesF)
 
 -- | Read installed interface
 readInstalledInterfaces :: FilePath -> ExceptT String IO [InstalledInterface]

@@ -1,6 +1,6 @@ module HDocs.Module (
 	-- * Get module docs
-	moduleDocs, installedDocs,
+	moduleDocsF, moduleDocs, installedDocsF, installedDocs,
 
 	-- * Utility
 	exportsDocs,
@@ -29,52 +29,56 @@ import qualified HDocs.Haddock as H
 
 -- | Load docs for all exported module symbols
-moduleDocs :: [String] -> String -> ExceptT String IO ModuleDocMap
-moduleDocs opts mname = ExceptT $ withInitializedPackages opts (runExceptT . moduleDocs') where
-	moduleDocs' :: DynFlags -> ExceptT String IO ModuleDocMap
-	moduleDocs' d = do
-		pkg <- case pkgs of
-			[] -> throwError $ "Module " ++ mname ++ " not found"
-			[pkg] -> return pkg
-			_ -> throwError $ "Module " ++ mname ++ " found in several packages: " ++ intercalate ", " (map (pkgId d) pkgs)
-		ifaces <- H.readPackageInterfaces pkg
-		iface <- maybe
-			(throwError $ "Module " ++ mname ++ " not found in package " ++ pkgId d pkg)
-			return
-			(find ((== mname) . moduleNameString . moduleName . instMod) ifaces)
+moduleDocsF :: DynFlags -> String -> ExceptT String IO ModuleDocMap
+moduleDocsF df mname = do
+	pkg <- case pkgs of
+		[] -> throwError $ "Module " ++ mname ++ " not found"
+		[pkg] -> return pkg
+		_ -> throwError $ "Module " ++ mname ++ " found in several packages: " ++ intercalate ", " (map (pkgId df) pkgs)
+	ifaces <- H.readPackageInterfaces pkg
+	iface <- maybe
+		(throwError $ "Module " ++ mname ++ " not found in package " ++ pkgId df pkg)
+		return
+		(find ((== mname) . moduleNameString . moduleName . instMod) ifaces)
 
-		depsfaces <- liftM concat $ mapM H.readPackageInterfaces $
-			map (getPackageDetails d) $ ifacePackageDeps iface
+	depsfaces <- liftM concat $ mapM H.readPackageInterfaces $
+		map (getPackageDetails df) $ ifacePackageDeps iface
 
-		let
-			deps = filter (ifaceDep iface) $ ifaces ++ depsfaces
+	let
+		deps = filter (ifaceDep iface) $ ifaces ++ depsfaces
 
-		return $ snd $ exportsDocs (H.installedInterfacesDocs deps) iface
-		where
-			pkgs = filter exposed $ map snd $ lookupModuleInAllPackages d (mkModuleName mname)
+	return $ snd $ exportsDocs (H.installedInterfacesDocs deps) iface
+	where
+		pkgs = filter exposed $ map snd $ lookupModuleInAllPackages df (mkModuleName mname)
 
-	namePackage :: Name -> Compat.UnitId
-	namePackage = Compat.moduleUnitId . nameModule
+		namePackage :: Name -> Compat.UnitId
+		namePackage = Compat.moduleUnitId . nameModule
 
-	ifacePackageDeps :: InstalledInterface -> [Compat.UnitId]
-	ifacePackageDeps i = (Compat.moduleUnitId $ instMod i) `delete` (nub . map namePackage . instExports $ i)
+		ifacePackageDeps :: InstalledInterface -> [Compat.UnitId]
+		ifacePackageDeps i = (Compat.moduleUnitId $ instMod i) `delete` (nub . map namePackage . instExports $ i)
 
-	ifaceDep :: InstalledInterface -> InstalledInterface -> Bool
-	ifaceDep i idep = instMod i /= instMod idep && instMod idep `elem` map nameModule (instExports i)
+		ifaceDep :: InstalledInterface -> InstalledInterface -> Bool
+		ifaceDep i idep = instMod i /= instMod idep && instMod idep `elem` map nameModule (instExports i)
 
-	pkgId :: DynFlags -> PackageConfig -> String
-	pkgId d = showSDoc d . ppr . Compat.unitId
+		pkgId :: DynFlags -> PackageConfig -> String
+		pkgId d = showSDoc d . ppr . Compat.unitId
 
+-- | Load docs for all exported module symbols
+moduleDocs :: [String] -> String -> ExceptT String IO ModuleDocMap
+moduleDocs opts mname = ExceptT $ withInitializedPackages opts (runExceptT . flip moduleDocsF mname) where
+
 -- | Load docs for all installed modules
+installedDocsF :: DynFlags -> ExceptT String IO (Map String ModuleDocMap)
+installedDocsF df = do
+	fs <- maybe (throwError "Package database empty") (return . concatMap haddockInterfaces) $ Compat.pkgDatabase df
+	ifaces <- liftM concat $ mapM ((`mplus` return []) . H.readInstalledInterfaces) fs
+	let
+		idocs = H.installedInterfacesDocs ifaces
+	return $ M.fromList $ map (exportsDocs idocs) ifaces
+
+-- | Load docs for all installed modules
 installedDocs :: [String] -> ExceptT String IO (Map String ModuleDocMap)
-installedDocs opts = ExceptT $ withInitializedPackages opts (runExceptT . installedDocs') where
-	installedDocs' :: DynFlags -> ExceptT String IO (Map String ModuleDocMap)
-	installedDocs' d = do
-		fs <- maybe (throwError "Package database empty") (return . concatMap haddockInterfaces) $ Compat.pkgDatabase d
-		ifaces <- liftM concat $ mapM ((`mplus` return []) . H.readInstalledInterfaces) fs
-		let
-			idocs = H.installedInterfacesDocs ifaces
-		return $ M.fromList $ map (exportsDocs idocs) ifaces
+installedDocs opts = ExceptT $ withInitializedPackages opts (runExceptT . installedDocsF)
 
 -- | Get docs for 'InstalledInterface' with its exports docs
 exportsDocs :: Map String ModuleDocMap -> InstalledInterface -> (String, ModuleDocMap)