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

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