-- -- Haddock - A Haskell Documentation Tool -- -- (c) Simon Marlow 2003 -- module Haddock.Packages ( HaddockPackage(..), getHaddockPackages, combineLinkEnvs ) where import Haddock.Types import Haddock.Exception import Haddock.InterfaceFile import Data.Maybe import qualified Data.Map as Map import Control.Monad import Control.Exception import System.Directory import GHC import DynFlags import Module import Packages -- | This structure represents the installed Haddock information for a -- package. This is basically the contents of the .haddock file, the path -- to the html files and the list of modules in the package data HaddockPackage = HaddockPackage { pdModules :: [Module], pdLinkEnv :: LinkEnv, pdHtmlPath :: FilePath } -- | Try to read the installed Haddock information for the given packages, -- if it exists. Print a warning on stdout if it couldn't be found for a -- package. getHaddockPackages :: [InstalledPackageInfo] -> IO [HaddockPackage] getHaddockPackages pkgInfos = liftM catMaybes $ mapM tryGetPackage pkgInfos where -- try to get a HaddockPackage, warn if we can't tryGetPackage pkgInfo = (getPackage pkgInfo >>= return . Just) `catchDyn` (\(e::HaddockException) -> do let pkgName = showPackageId (package pkgInfo) putStrLn ("Warning: Cannot use package " ++ pkgName ++ ":") putStrLn (" " ++ show e) return Nothing ) -- | Try to read a HaddockPackage structure for a package getPackage :: InstalledPackageInfo -> IO HaddockPackage getPackage pkgInfo = do html <- getHtml pkgInfo ifacePath <- getIface pkgInfo iface <- readInterfaceFile ifacePath return $ HaddockPackage { pdModules = packageModules pkgInfo, pdLinkEnv = ifLinkEnv iface, pdHtmlPath = html } -- | Recreate exposed modules from an InstalledPackageInfo packageModules :: InstalledPackageInfo -> [Module] packageModules pkgInfo = map (mkModule (pkgId pkgInfo)) moduleNames where moduleNames = map mkModuleName (exposedModules pkgInfo) pkgId = mkPackageId . package -- | Get the Haddock HTML directory path for a package getHtml :: InstalledPackageInfo -> IO FilePath getHtml pkgInfo = case haddockHTMLs pkgInfo of (path:_) | not (null path) -> do dirExists <- doesDirectoryExist path if dirExists then return path else throwE $ "HTML directory " ++ path ++ " does not exist." _ -> throwE "No Haddock documentation installed." -- | Get the Haddock interface path for a package getIface :: InstalledPackageInfo -> IO FilePath getIface pkgInfo = case haddockInterfaces pkgInfo of (file:_) | not (null file) -> do fileExists <- doesFileExist file if fileExists then return file else throwE $ "Interface file " ++ file ++ " does not exist." _ -> throwE "No Haddock interface installed." -- | Build one big link env out of a list of packages. If multiple packages -- export the same (original) name, we just pick one of the packages as the -- documentation site. combineLinkEnvs :: [HaddockPackage] -> LinkEnv combineLinkEnvs packages = Map.unions (map pdLinkEnv packages)