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')
]