aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Packages.hs
blob: d722bdfe74c031c526a6db1b90e0c40d8e16c671 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
--
-- 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)