cabal-install/src/Distribution/Client/Haddock.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Distribution.Client.Haddock
   4 -- Copyright   :  (c) Andrea Vezzosi 2009
   5 -- License     :  BSD-like
   6 --
   7 -- Maintainer  :  cabal-devel@haskell.org
   8 -- Portability :  portable
   9 --
  10 -- Interfacing with Haddock
  11 --
  12 -----------------------------------------------------------------------------
  13 module Distribution.Client.Haddock
  14     (
  15      regenerateHaddockIndex
  16     )
  17     where
  18
  19 import Distribution.Client.Compat.Prelude
  20 import Prelude ()
  21
  22 import Data.List (maximumBy)
  23 import System.Directory (createDirectoryIfMissing, renameFile)
  24 import System.FilePath ((</>), splitFileName)
  25 import Distribution.Package
  26          ( packageVersion )
  27 import Distribution.Simple.Haddock (haddockPackagePaths)
  28 import Distribution.Simple.Program (haddockProgram, ProgramDb
  29                                    , runProgram, requireProgramVersion)
  30 import Distribution.Version (mkVersion, orLaterVersion)
  31 import Distribution.Simple.PackageIndex
  32          ( InstalledPackageIndex, allPackagesByName )
  33 import Distribution.Simple.Utils
  34          ( debug, installDirectoryContents, withTempDirectory )
  35 import Distribution.InstalledPackageInfo as InstalledPackageInfo
  36          ( InstalledPackageInfo(exposed) )
  37
  38 regenerateHaddockIndex :: Verbosity
  39                        -> InstalledPackageIndex -> ProgramDb
  40                        -> FilePath
  41                        -> IO ()
  42 regenerateHaddockIndex verbosity pkgs progdb index = do
  43       (paths, warns) <- haddockPackagePaths pkgs' Nothing
  44       let paths' = [ (interface, html) | (interface, Just html, _, _) <- paths]
  45       for_ warns (debug verbosity)
  46
  47       (confHaddock, _, _) <-
  48           requireProgramVersion verbosity haddockProgram
  49                                     (orLaterVersion (mkVersion [0,6])) progdb
  50
  51       createDirectoryIfMissing True destDir
  52
  53       withTempDirectory verbosity destDir "tmphaddock" $ \tempDir -> do
  54
  55         let flags = [ "--gen-contents"
  56                     , "--gen-index"
  57                     , "--odir=" ++ tempDir
  58                     , "--title=Haskell modules on this system" ]
  59                  ++ [ "--read-interface=" ++ html ++ "," ++ interface
  60                     | (interface, html) <- paths' ]
  61         runProgram verbosity confHaddock flags
  62         renameFile (tempDir </> "index.html") (tempDir </> destFile)
  63         installDirectoryContents verbosity tempDir destDir
  64
  65   where
  66     (destDir,destFile) = splitFileName index
  67     pkgs' :: [InstalledPackageInfo]
  68     pkgs' = [ maximumBy (comparing packageVersion) pkgvers'
  69             | (_pname, pkgvers) <- allPackagesByName pkgs
  70             , let pkgvers' = filter exposed pkgvers
  71             , not (null pkgvers') ]