module Distribution.Client.Haddock
(
regenerateHaddockIndex
)
where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Data.List (maximumBy)
import System.Directory (createDirectoryIfMissing, renameFile)
import System.FilePath ((</>), splitFileName)
import Distribution.Package
( packageVersion )
import Distribution.Simple.Haddock (haddockPackagePaths)
import Distribution.Simple.Program (haddockProgram, ProgramDb
, runProgram, requireProgramVersion)
import Distribution.Version (mkVersion, orLaterVersion)
import Distribution.Simple.PackageIndex
( InstalledPackageIndex, allPackagesByName )
import Distribution.Simple.Utils
( debug, installDirectoryContents, withTempDirectory )
import Distribution.InstalledPackageInfo as InstalledPackageInfo
( InstalledPackageInfo(exposed) )
regenerateHaddockIndex :: Verbosity
-> InstalledPackageIndex -> ProgramDb
-> FilePath
-> IO ()
regenerateHaddockIndex :: Verbosity
-> InstalledPackageIndex -> ProgramDb -> FilePath -> IO ()
regenerateHaddockIndex Verbosity
verbosity InstalledPackageIndex
pkgs ProgramDb
progdb FilePath
index = do
([(FilePath, Maybe FilePath, Maybe FilePath, Visibility)]
paths, Maybe FilePath
warns) <- [InstalledPackageInfo]
-> Maybe (InstalledPackageInfo -> FilePath)
-> IO
([(FilePath, Maybe FilePath, Maybe FilePath, Visibility)],
Maybe FilePath)
haddockPackagePaths [InstalledPackageInfo]
pkgs' forall a. Maybe a
Nothing
let paths' :: [(FilePath, FilePath)]
paths' = [ (FilePath
interface, FilePath
html) | (FilePath
interface, Just FilePath
html, Maybe FilePath
_, Visibility
_) <- [(FilePath, Maybe FilePath, Maybe FilePath, Visibility)]
paths]
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe FilePath
warns (Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity)
(ConfiguredProgram
confHaddock, Version
_, ProgramDb
_) <-
Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity Program
haddockProgram
(Version -> VersionRange
orLaterVersion ([Int] -> Version
mkVersion [Int
0,Int
6])) ProgramDb
progdb
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
destDir
forall a.
Verbosity -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempDirectory Verbosity
verbosity FilePath
destDir FilePath
"tmphaddock" forall a b. (a -> b) -> a -> b
$ \FilePath
tempDir -> do
let flags :: [FilePath]
flags = [ FilePath
"--gen-contents"
, FilePath
"--gen-index"
, FilePath
"--odir=" forall a. [a] -> [a] -> [a]
++ FilePath
tempDir
, FilePath
"--title=Haskell modules on this system" ]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"--read-interface=" forall a. [a] -> [a] -> [a]
++ FilePath
html forall a. [a] -> [a] -> [a]
++ 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' = [ forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall pkg. Package pkg => pkg -> Version
packageVersion) [InstalledPackageInfo]
pkgvers'
| (PackageName
_pname, [InstalledPackageInfo]
pkgvers) <- forall a. PackageIndex a -> [(PackageName, [a])]
allPackagesByName InstalledPackageIndex
pkgs
, let pkgvers' :: [InstalledPackageInfo]
pkgvers' = forall a. (a -> Bool) -> [a] -> [a]
filter InstalledPackageInfo -> Bool
exposed [InstalledPackageInfo]
pkgvers
, Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InstalledPackageInfo]
pkgvers') ]