module HDocs.Module (

	-- * Get module docs

	moduleDocsF, moduleDocs, installedDocsF, installedDocs,



	-- * Utility

	exportsDocs,



	module HDocs.Base

	) where



import Control.Applicative

import Control.Monad.Except



import Data.List

import Data.Map (Map)

import qualified Data.Map as M

import Data.Maybe



import Documentation.Haddock



import DynFlags

import Module

import Outputable (showSDoc, ppr)

import Packages

import Name



import HDocs.Base

import qualified HDocs.Ghc.Compat as Compat

import qualified HDocs.Haddock as H



-- | Load docs for all exported module symbols

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 df) $ ifacePackageDeps iface



	let

		deps = filter (ifaceDep iface) $ ifaces ++ depsfaces



	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



		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)



		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 . installedDocsF)



-- | Get docs for 'InstalledInterface' with its exports docs

exportsDocs :: Map String ModuleDocMap -> InstalledInterface -> (String, ModuleDocMap)

exportsDocs docs iface = (iname, snd (H.installedInterfaceDocs iface) `M.union` edocs) where

	iname = moduleNameString $ moduleName $ instMod iface

	edocs = M.fromList $ mapMaybe findDoc (instExports iface)

	findDoc n = ((,) (getOccString n)) <$> (H.lookupNameDoc n docs)