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)