-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Client.Haddock
-- Copyright   :  (c) Andrea Vezzosi 2009
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Interfacing with Haddock
module Distribution.Client.Haddock
  ( regenerateHaddockIndex
  )
where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Data.List (maximumBy)
import Distribution.InstalledPackageInfo as InstalledPackageInfo
  ( InstalledPackageInfo (exposed)
  )
import Distribution.Package
  ( packageVersion
  )
import Distribution.Simple.Haddock (haddockPackagePaths)
import Distribution.Simple.PackageIndex
  ( InstalledPackageIndex
  , allPackagesByName
  )
import Distribution.Simple.Program
  ( ProgramDb
  , haddockProgram
  , requireProgramVersion
  , runProgram
  )
import Distribution.Simple.Utils
  ( debug
  , installDirectoryContents
  , withTempDirectory
  )
import Distribution.Version (mkVersion, orLaterVersion)
import System.Directory (createDirectoryIfMissing, renameFile)
import System.FilePath (splitFileName, (</>))

regenerateHaddockIndex
  :: Verbosity
  -> InstalledPackageIndex
  -> ProgramDb
  -> FilePath
  -> IO ()
regenerateHaddockIndex :: Verbosity
-> InstalledPackageIndex -> ProgramDb -> FilePath -> IO ()
regenerateHaddockIndex Verbosity
verbosity InstalledPackageIndex
pkgs ProgramDb
progdb FilePath
index = do
  (paths, warns) <- [InstalledPackageInfo]
-> Maybe (InstalledPackageInfo -> FilePath)
-> IO
     ([(FilePath, Maybe FilePath, Maybe FilePath, Visibility)],
      Maybe FilePath)
haddockPackagePaths [InstalledPackageInfo]
pkgs' Maybe (InstalledPackageInfo -> FilePath)
forall a. Maybe a
Nothing
  let paths' = [(FilePath
interface, FilePath
html) | (FilePath
interface, Just FilePath
html, Maybe FilePath
_, Visibility
_) <- [(FilePath, Maybe FilePath, Maybe FilePath, Visibility)]
paths]
  for_ warns (debug verbosity)

  (confHaddock, _, _) <-
    requireProgramVersion
      verbosity
      haddockProgram
      (orLaterVersion (mkVersion [0, 6]))
      progdb

  createDirectoryIfMissing True destDir

  withTempDirectory verbosity destDir "tmphaddock" $ \FilePath
tempDir -> do
    let flags :: [FilePath]
flags =
          [ FilePath
"--gen-contents"
          , FilePath
"--gen-index"
          , FilePath
"--odir=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
tempDir
          , FilePath
"--title=Haskell modules on this system"
          ]
            [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"--read-interface=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
html FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"," FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
interface
               | (FilePath
interface, FilePath
html) <- [(FilePath, FilePath)]
paths'
               ]
    Verbosity -> ConfiguredProgram -> [FilePath] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
confHaddock [FilePath]
flags
    FilePath -> FilePath -> IO ()
renameFile (FilePath
tempDir FilePath -> FilePath -> FilePath
</> FilePath
"index.html") (FilePath
tempDir FilePath -> FilePath -> FilePath
</> FilePath
destFile)
    Verbosity -> FilePath -> FilePath -> IO ()
installDirectoryContents Verbosity
verbosity FilePath
tempDir FilePath
destDir
  where
    (FilePath
destDir, FilePath
destFile) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
index
    pkgs' :: [InstalledPackageInfo]
    pkgs' :: [InstalledPackageInfo]
pkgs' =
      [ (InstalledPackageInfo -> InstalledPackageInfo -> Ordering)
-> [InstalledPackageInfo] -> InstalledPackageInfo
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((InstalledPackageInfo -> Version)
-> InstalledPackageInfo -> InstalledPackageInfo -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing InstalledPackageInfo -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion) [InstalledPackageInfo]
pkgvers'
      | (PackageName
_pname, [InstalledPackageInfo]
pkgvers) <- InstalledPackageIndex -> [(PackageName, [InstalledPackageInfo])]
forall a. PackageIndex a -> [(PackageName, [a])]
allPackagesByName InstalledPackageIndex
pkgs
      , let pkgvers' :: [InstalledPackageInfo]
pkgvers' = (InstalledPackageInfo -> Bool)
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter InstalledPackageInfo -> Bool
exposed [InstalledPackageInfo]
pkgvers
      , Bool -> Bool
not ([InstalledPackageInfo] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InstalledPackageInfo]
pkgvers')
      ]