diff --git a/Cabal/src/Distribution/Simple/BuildPaths.hs b/Cabal/src/Distribution/Simple/BuildPaths.hs
index c0305b7e9f0cde884d419886f030b481d58cb6ec..0875de87c91331d4d1b6eb60d1a367b861365372 100644
--- a/Cabal/src/Distribution/Simple/BuildPaths.hs
+++ b/Cabal/src/Distribution/Simple/BuildPaths.hs
@@ -20,6 +20,8 @@ module Distribution.Simple.BuildPaths
, buildInfoPref
, haddockDirName
, haddockLibraryDirPath
+ , haddockTestDirPath
+ , haddockBenchmarkDirPath
, hscolourPref
, haddockPref
, autogenPackageModulesDir
@@ -49,6 +51,8 @@ module Distribution.Simple.BuildPaths
, getSourceFiles
, getLibSourceFiles
, getExeSourceFiles
+ , getTestSourceFiles
+ , getBenchmarkSourceFiles
, getFLibSourceFiles
, exeBuildDir
, flibBuildDir
@@ -119,6 +123,22 @@ haddockLibraryDirPath haddockTarget pkg_descr lib =
haddockDirName haddockTarget pkg_descr </> prettyShow sublib_name
_ -> haddockDirName haddockTarget pkg_descr
+haddockTestDirPath
+ :: HaddockTarget
+ -> PackageDescription
+ -> TestSuite
+ -> FilePath
+haddockTestDirPath haddockTarget pkg_descr test =
+ haddockDirName haddockTarget pkg_descr </> prettyShow (testName test)
+
+haddockBenchmarkDirPath
+ :: HaddockTarget
+ -> PackageDescription
+ -> Benchmark
+ -> FilePath
+haddockBenchmarkDirPath haddockTarget pkg_descr bench =
+ haddockDirName haddockTarget pkg_descr </> prettyShow (benchmarkName bench)
+
-- | The directory to which generated haddock documentation should be written.
haddockPref
:: HaddockTarget
@@ -234,6 +254,48 @@ getExeSourceFiles verbosity lbi exe clbi = do
: coerceSymbolicPath (exeBuildDir lbi exe)
: hsSourceDirs bi
+getTestSourceFiles
+ :: Verbosity
+ -> LocalBuildInfo
+ -> TestSuite
+ -> ComponentLocalBuildInfo
+ -> IO [(ModuleName.ModuleName, SymbolicPath Pkg 'File)]
+getTestSourceFiles verbosity lbi test@TestSuite{testInterface = TestSuiteExeV10 _ path} clbi = do
+ moduleFiles <- getSourceFiles verbosity mbWorkDir searchpaths modules
+ srcMainPath <- findFileCwd verbosity mbWorkDir (hsSourceDirs bi) path
+ return ((ModuleName.main, srcMainPath) : moduleFiles)
+ where
+ mbWorkDir = mbWorkDirLBI lbi
+ bi = testBuildInfo test
+ modules = otherModules bi
+ searchpaths =
+ autogenComponentModulesDir lbi clbi
+ : autogenPackageModulesDir lbi
+ : coerceSymbolicPath (testBuildDir lbi test)
+ : hsSourceDirs bi
+getTestSourceFiles _ _ _ _ = return []
+
+getBenchmarkSourceFiles
+ :: Verbosity
+ -> LocalBuildInfo
+ -> Benchmark
+ -> ComponentLocalBuildInfo
+ -> IO [(ModuleName.ModuleName, SymbolicPath Pkg 'File)]
+getBenchmarkSourceFiles verbosity lbi bench@Benchmark{benchmarkInterface = BenchmarkExeV10 _ path} clbi = do
+ moduleFiles <- getSourceFiles verbosity mbWorkDir searchpaths modules
+ srcMainPath <- findFileCwd verbosity mbWorkDir (hsSourceDirs bi) path
+ return ((ModuleName.main, srcMainPath) : moduleFiles)
+ where
+ mbWorkDir = mbWorkDirLBI lbi
+ bi = benchmarkBuildInfo bench
+ modules = otherModules bi
+ searchpaths =
+ autogenComponentModulesDir lbi clbi
+ : autogenPackageModulesDir lbi
+ : coerceSymbolicPath (benchmarkBuildDir lbi bench)
+ : hsSourceDirs bi
+getBenchmarkSourceFiles _ _ _ _ = return []
+
getFLibSourceFiles
:: Verbosity
-> LocalBuildInfo
diff --git a/Cabal/src/Distribution/Simple/Haddock.hs b/Cabal/src/Distribution/Simple/Haddock.hs
index facfe14a6be0c51aa2c71366229fb35890262c5f..ba025a8554939a031cebb261ed8220ff7d03e72e 100644
--- a/Cabal/src/Distribution/Simple/Haddock.hs
+++ b/Cabal/src/Distribution/Simple/Haddock.hs
@@ -92,6 +92,7 @@ import Distribution.Verbosity
import Distribution.Version
import Control.Monad
+import Data.Bool (bool)
import Data.Either (rights)
import System.Directory (doesDirectoryExist, doesFileExist)
import System.FilePath (isAbsolute, normalise)
@@ -483,8 +484,54 @@ haddock_setupHooks
)
>> return index
CExe _ -> when (flag haddockExecutables) (smsg >> doExe component) >> return index
- CTest _ -> when (flag haddockTestSuites) (smsg >> doExe component) >> return index
- CBench _ -> when (flag haddockBenchmarks) (smsg >> doExe component) >> return index
+ CTest test -> do
+ when (flag haddockTestSuites) $ do
+ smsg
+ testArgs <-
+ fromTest
+ verbosity
+ haddockArtifactsDirs
+ lbi'
+ clbi
+ htmlTemplate
+ haddockTarget
+ pkg_descr
+ test
+ commonArgs
+ runHaddock
+ verbosity
+ mbWorkDir
+ tmpFileOpts
+ comp
+ platform
+ haddockProg
+ True
+ testArgs
+ return index
+ CBench bench -> do
+ when (flag haddockBenchmarks) $ do
+ smsg
+ benchArgs <-
+ fromBenchmark
+ verbosity
+ haddockArtifactsDirs
+ lbi'
+ clbi
+ htmlTemplate
+ haddockTarget
+ pkg_descr
+ bench
+ commonArgs
+ runHaddock
+ verbosity
+ mbWorkDir
+ tmpFileOpts
+ comp
+ platform
+ haddockProg
+ True
+ benchArgs
+ return index
return ipi
@@ -792,6 +839,106 @@ fromExecutable verbosity haddockArtifactsDirs lbi clbi htmlTemplate haddockTarge
NoFlag -> NoFlag
}
+fromTest
+ :: Verbosity
+ -> (SymbolicPath Pkg (Path.Dir Artifacts), SymbolicPath Pkg (Path.Dir Artifacts), SymbolicPath Pkg (Path.Dir Artifacts))
+ -- ^ Directories for -hidir, -odir, and -stubdir to GHC through Haddock.
+ -- See Note [Hi Haddock Recompilation Avoidance]
+ -> LocalBuildInfo
+ -> ComponentLocalBuildInfo
+ -> Maybe PathTemplate
+ -- ^ template for HTML location
+ -> HaddockTarget
+ -> PackageDescription
+ -> TestSuite
+ -> HaddockArgs
+ -- ^ common args
+ -> IO HaddockArgs
+fromTest verbosity haddockArtifactsDirs lbi clbi htmlTemplate haddockTarget pkg_descr test commonArgs = do
+ inFiles <- map snd `fmap` getTestSourceFiles verbosity lbi test clbi
+ args <-
+ mkHaddockArgs
+ verbosity
+ haddockArtifactsDirs
+ lbi
+ clbi
+ htmlTemplate
+ inFiles
+ (testBuildInfo test)
+ let args' =
+ commonArgs
+ <> args
+ { argOutputDir =
+ Dir $
+ haddockDirName haddockTarget pkg_descr
+ </> unUnqualComponentName (testName test)
+ }
+ return
+ args'
+ { argTitle = Flag $ prettyShow (packageName pkg_descr)
+ , argComponentName = Flag $ prettyShow (packageName pkg_descr) ++ ":" ++ unUnqualComponentName (testName test)
+ , -- we need to accommodate `argOutputDir`
+ argBaseUrl = case argBaseUrl args' of
+ Flag url -> Flag $ ".." </> url
+ NoFlag -> NoFlag
+ , argContents = case argContents args' of
+ Flag url -> Flag $ ".." </> url
+ NoFlag -> NoFlag
+ , argIndex = case argIndex args' of
+ Flag url -> Flag $ ".." </> url
+ NoFlag -> NoFlag
+ }
+
+fromBenchmark
+ :: Verbosity
+ -> (SymbolicPath Pkg (Path.Dir Artifacts), SymbolicPath Pkg (Path.Dir Artifacts), SymbolicPath Pkg (Path.Dir Artifacts))
+ -- ^ Directories for -hidir, -odir, and -stubdir to GHC through Haddock.
+ -- See Note [Hi Haddock Recompilation Avoidance]
+ -> LocalBuildInfo
+ -> ComponentLocalBuildInfo
+ -> Maybe PathTemplate
+ -- ^ template for HTML location
+ -> HaddockTarget
+ -> PackageDescription
+ -> Benchmark
+ -> HaddockArgs
+ -- ^ common args
+ -> IO HaddockArgs
+fromBenchmark verbosity haddockArtifactsDirs lbi clbi htmlTemplate haddockTarget pkg_descr bench commonArgs = do
+ inFiles <- map snd `fmap` getBenchmarkSourceFiles verbosity lbi bench clbi
+ args <-
+ mkHaddockArgs
+ verbosity
+ haddockArtifactsDirs
+ lbi
+ clbi
+ htmlTemplate
+ inFiles
+ (benchmarkBuildInfo bench)
+ let args' =
+ commonArgs
+ <> args
+ { argOutputDir =
+ Dir $
+ haddockDirName haddockTarget pkg_descr
+ </> unUnqualComponentName (benchmarkName bench)
+ }
+ return
+ args'
+ { argTitle = Flag $ prettyShow (packageName pkg_descr)
+ , argComponentName = Flag $ prettyShow (packageName pkg_descr) ++ ":" ++ unUnqualComponentName (benchmarkName bench)
+ , -- we need to accommodate `argOutputDir`
+ argBaseUrl = case argBaseUrl args' of
+ Flag url -> Flag $ ".." </> url
+ NoFlag -> NoFlag
+ , argContents = case argContents args' of
+ Flag url -> Flag $ ".." </> url
+ NoFlag -> NoFlag
+ , argIndex = case argIndex args' of
+ Flag url -> Flag $ ".." </> url
+ NoFlag -> NoFlag
+ }
+
fromForeignLib
:: Verbosity
-> (SymbolicPath Pkg (Path.Dir Artifacts), SymbolicPath Pkg (Path.Dir Artifacts), SymbolicPath Pkg (Path.Dir Artifacts))
@@ -1068,10 +1215,10 @@ renderPureArgs version comp platform args =
, [ "--quickjump" | isVersion 2 19, True <- flagToList . argQuickJump $ args
]
, ["--hyperlinked-source" | isHyperlinkedSource]
- , (\(All b, xs) -> bool (map (("--hide=" ++) . prettyShow) xs) [] b)
+ , (\(All b, xs) -> bool [] (map (("--hide=" ++) . prettyShow) xs) b)
. argHideModules
$ args
- , bool ["--ignore-all-exports"] [] . getAny . argIgnoreExports $ args
+ , bool [] ["--ignore-all-exports"] . getAny . argIgnoreExports $ args
, -- Haddock's --source-* options are ignored once --hyperlinked-source is
-- set.
-- See https://haskell-haddock.readthedocs.io/en/latest/invoking.html#cmdoption-hyperlinked-source
@@ -1095,11 +1242,11 @@ renderPureArgs version comp platform args =
$ args
, maybe [] ((: []) . ("--css=" ++)) . flagToMaybe . argCssFile $ args
, maybe [] ((: []) . ("--use-contents=" ++)) . flagToMaybe . argContents $ args
- , bool ["--gen-contents"] [] . fromFlagOrDefault False . argGenContents $ args
+ , bool [] ["--gen-contents"] . fromFlagOrDefault False . argGenContents $ args
, maybe [] ((: []) . ("--use-index=" ++)) . flagToMaybe . argIndex $ args
- , bool ["--gen-index"] [] . fromFlagOrDefault False . argGenIndex $ args
+ , bool [] ["--gen-index"] . fromFlagOrDefault False . argGenIndex $ args
, maybe [] ((: []) . ("--base-url=" ++)) . flagToMaybe . argBaseUrl $ args
- , bool [] [verbosityFlag] . getAny . argVerbose $ args
+ , bool [verbosityFlag] [] . getAny . argVerbose $ args
, map (\o -> case o of Hoogle -> "--hoogle"; Html -> "--html")
. fromFlagOrDefault []
. argOutput
@@ -1111,8 +1258,8 @@ renderPureArgs version comp platform args =
( (: [])
. ("--title=" ++)
. ( bool
- (++ " (internal documentation)")
id
+ (++ " (internal documentation)")
(getAny $ argIgnoreExports args)
)
)
@@ -1134,7 +1281,7 @@ renderPureArgs version comp platform args =
-- We pass this option by default to haddock to avoid recompilation
-- See Note [Hi Haddock Recompilation Avoidance]
["--no-tmp-comp-dir" | version >= mkVersion [2, 28, 0]]
- , bool ["--use-unicode"] [] . fromFlagOrDefault False . argUseUnicode $ args
+ , bool [] ["--use-unicode"] . fromFlagOrDefault False . argUseUnicode $ args
]
where
-- See Note [Symbolic paths] in Distribution.Utils.Path
@@ -1173,7 +1320,6 @@ renderPureArgs version comp platform args =
]
)
- bool a b c = if c then a else b
isVersion major minor = version >= mkVersion [major, minor]
verbosityFlag
| isVersion 2 5 = "--verbosity=1"
diff --git a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs
index 510d4084be6c95feb48e793a0dd3d65934c8507f..f632e8b7caaca98a011fb690a21ce03da5fc7807 100644
--- a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs
+++ b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs
@@ -53,10 +53,12 @@ import Distribution.Client.Setup
import Distribution.Client.TargetProblem (TargetProblem (..))
import Distribution.Simple.BuildPaths
- ( haddockDirName
+ ( haddockBenchmarkDirPath
+ , haddockDirName
, haddockLibraryDirPath
, haddockLibraryPath
, haddockPath
+ , haddockTestDirPath
)
import Distribution.Simple.Command
( CommandUI (..)
@@ -95,7 +97,7 @@ import Distribution.Simple.Utils
, warn
)
import Distribution.Types.InstalledPackageInfo (InstalledPackageInfo (..))
-import Distribution.Types.PackageDescription (PackageDescription (subLibraries))
+import Distribution.Types.PackageDescription (PackageDescription (benchmarks, subLibraries, testSuites))
import Distribution.Types.PackageId (pkgName)
import Distribution.Types.PackageName (unPackageName)
import Distribution.Types.UnitId (unUnitId)
@@ -312,6 +314,22 @@ haddockProjectAction flags _extraArgs globalFlags = do
</> sublibDirPath
</> haddockLibraryPath pkg_descr lib
]
+ ++ [ (testPath, testInterfacePath, Visible)
+ | test <- testSuites pkg_descr
+ , let testPath = haddockTestDirPath ForDevelopment pkg_descr test
+ testInterfacePath =
+ outputDir
+ </> testPath
+ </> haddockPath pkg_descr
+ ]
+ ++ [ (benchPath, benchInterfacePath, Visible)
+ | bench <- benchmarks pkg_descr
+ , let benchPath = haddockBenchmarkDirPath ForDevelopment pkg_descr bench
+ benchInterfacePath =
+ outputDir
+ </> benchPath
+ </> haddockPath pkg_descr
+ ]
infos' <-
mapM
( \x@(_, path, _) -> do