Commit fea6b089 authored by ttuegel's avatar ttuegel
Browse files

Merge pull request #1374 from Jookia/haddock-finished

Added support for test and benchmark documentation with Haddock.
parents 17ec8710 f91f8998
......@@ -58,7 +58,9 @@ import Distribution.Package
import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription as PD
( PackageDescription(..), BuildInfo(..), allExtensions
, Library(..), hasLibs, Executable(..) )
, Library(..), hasLibs, Executable(..)
, TestSuite(..), TestSuiteInterface(..)
, Benchmark(..), BenchmarkInterface(..) )
import Distribution.Simple.Compiler
( Compiler(..), compilerVersion )
import Distribution.Simple.GHC ( componentGhcOptions, ghcLibDir )
......@@ -151,10 +153,13 @@ data Output = Html | Hoogle
haddock :: PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HaddockFlags -> IO ()
haddock pkg_descr _ _ haddockFlags
| not (hasLibs pkg_descr)
&& not (fromFlag $ haddockExecutables haddockFlags) =
&& not (fromFlag $ haddockExecutables haddockFlags)
&& not (fromFlag $ haddockTestSuites haddockFlags)
&& not (fromFlag $ haddockBenchmarks haddockFlags) =
warn (fromFlag $ haddockVerbosity haddockFlags) $
"No documentation was generated as this package does not contain "
++ "a library. Perhaps you want to use the --executables flag."
++ "a library. Perhaps you want to use the --executables, --tests or"
++ " --benchmarks flags."
haddock pkg_descr lbi suffixes flags = do
......@@ -204,6 +209,19 @@ haddock pkg_descr lbi suffixes flags = do
let pre c = preprocessComponent pkg_descr c lbi False verbosity suffixes
withAllComponentsInBuildOrder pkg_descr lbi $ \comp clbi -> do
pre comp
let
doExe com = case (compToExe com) of
Just exe -> do
withTempDirectory verbosity keepTempFiles (buildDir lbi) "tmp" $ \tmp -> do
let bi = buildInfo exe
exeArgs <- fromExecutable verbosity tmp lbi exe clbi htmlTemplate
exeArgs' <- prepareSources verbosity tmp
lbi isVersion2 bi (commonArgs `mappend` exeArgs)
runHaddock verbosity keepTempFiles confHaddock exeArgs'
Nothing -> do
warn (fromFlag $ haddockVerbosity flags)
"Unsupported component, skipping..."
return ()
case comp of
CLib lib -> do
withTempDirectory verbosity keepTempFiles (buildDir lbi) "tmp" $ \tmp -> do
......@@ -212,14 +230,9 @@ haddock pkg_descr lbi suffixes flags = do
libArgs' <- prepareSources verbosity tmp
lbi isVersion2 bi (commonArgs `mappend` libArgs)
runHaddock verbosity keepTempFiles confHaddock libArgs'
CExe exe -> when (flag haddockExecutables) $ do
withTempDirectory verbosity keepTempFiles (buildDir lbi) "tmp" $ \tmp -> do
let bi = buildInfo exe
exeArgs <- fromExecutable verbosity tmp lbi exe clbi htmlTemplate
exeArgs' <- prepareSources verbosity tmp
lbi isVersion2 bi (commonArgs `mappend` exeArgs)
runHaddock verbosity keepTempFiles confHaddock exeArgs'
_ -> return ()
CExe _ -> when (flag haddockExecutables) $ doExe comp
CTest _ -> when (flag haddockTestSuites) $ doExe comp
CBench _ -> when (flag haddockBenchmarks) $ doExe comp
forM_ (extraHtmlFiles pkg_descr) $ \ fpath -> do
files <- matchFileGlob fpath
......@@ -228,7 +241,7 @@ haddock pkg_descr lbi suffixes flags = do
verbosity = flag haddockVerbosity
keepTempFiles = flag haddockKeepTempFiles
flag f = fromFlag $ f flags
htmlTemplate = fmap toPathTemplate . flagToMaybe . haddockHtmlLocation $ flags
htmlTemplate = fmap toPathTemplate . flagToMaybe . haddockHtmlLocation $ flags
-- | performs cpp and unlit preprocessing where needed on the files in
-- | argTargets, which must have an .hs or .lhs extension.
......@@ -383,6 +396,24 @@ fromExecutable verbosity tmp lbi exe clbi htmlTemplate = do
bi = buildInfo exe
ghcVersion = compilerVersion (compiler lbi)
compToExe :: Component -> Maybe Executable
compToExe comp =
case comp of
CTest test@TestSuite { testInterface = TestSuiteExeV10 _ f } ->
Just Executable {
exeName = testName test,
modulePath = f,
buildInfo = testBuildInfo test
}
CBench bench@Benchmark { benchmarkInterface = BenchmarkExeV10 _ f } ->
Just Executable {
exeName = benchmarkName bench,
modulePath = f,
buildInfo = benchmarkBuildInfo bench
}
CExe exe -> Just exe
_ -> Nothing
getInterfaces :: Verbosity
-> LocalBuildInfo
-> ComponentLocalBuildInfo
......@@ -566,14 +597,22 @@ hscolour' pkg_descr lbi suffixes flags = do
let pre c = preprocessComponent pkg_descr c lbi False verbosity suffixes
withAllComponentsInBuildOrder pkg_descr lbi $ \comp _ -> do
pre comp
let
doExe com = case (compToExe com) of
Just exe -> do
let outputDir = hscolourPref distPref pkg_descr </> exeName exe </> "src"
runHsColour hscolourProg outputDir =<< getExeSourceFiles lbi exe
Nothing -> do
warn (fromFlag $ hscolourVerbosity flags)
"Unsupported component, skipping..."
return ()
case comp of
CLib lib -> do
let outputDir = hscolourPref distPref pkg_descr </> "src"
runHsColour hscolourProg outputDir =<< getLibSourceFiles lbi lib
CExe exe | fromFlag (hscolourExecutables flags) -> do
let outputDir = hscolourPref distPref pkg_descr </> exeName exe </> "src"
runHsColour hscolourProg outputDir =<< getExeSourceFiles lbi exe
_ -> return ()
CExe _ -> when (fromFlag (hscolourExecutables flags)) $ doExe comp
CTest _ -> when (fromFlag (hscolourTestSuites flags)) $ doExe comp
CBench _ -> when (fromFlag (hscolourBenchmarks flags)) $ doExe comp
where
stylesheet = flagToMaybe (hscolourCSS flags)
......@@ -600,6 +639,8 @@ haddockToHscolour flags =
HscolourFlags {
hscolourCSS = haddockHscolourCss flags,
hscolourExecutables = haddockExecutables flags,
hscolourTestSuites = haddockTestSuites flags,
hscolourBenchmarks = haddockBenchmarks flags,
hscolourVerbosity = haddockVerbosity flags,
hscolourDistPref = haddockDistPref flags
}
......
......@@ -194,6 +194,9 @@ flagToList :: Flag a -> [a]
flagToList (Flag x) = [x]
flagToList NoFlag = []
allFlags :: [Flag Bool] -> Flag Bool
allFlags flags = toFlag $ all (\f -> fromFlagOrDefault False f) flags
-- ------------------------------------------------------------
-- * Global flags
-- ------------------------------------------------------------
......@@ -985,6 +988,8 @@ instance Monoid RegisterFlags where
data HscolourFlags = HscolourFlags {
hscolourCSS :: Flag FilePath,
hscolourExecutables :: Flag Bool,
hscolourTestSuites :: Flag Bool,
hscolourBenchmarks :: Flag Bool,
hscolourDistPref :: Flag FilePath,
hscolourVerbosity :: Flag Verbosity
}
......@@ -997,6 +1002,8 @@ defaultHscolourFlags :: HscolourFlags
defaultHscolourFlags = HscolourFlags {
hscolourCSS = NoFlag,
hscolourExecutables = Flag False,
hscolourTestSuites = Flag False,
hscolourBenchmarks = Flag False,
hscolourDistPref = Flag defaultDistPref,
hscolourVerbosity = Flag normal
}
......@@ -1005,12 +1012,16 @@ instance Monoid HscolourFlags where
mempty = HscolourFlags {
hscolourCSS = mempty,
hscolourExecutables = mempty,
hscolourTestSuites = mempty,
hscolourBenchmarks = mempty,
hscolourDistPref = mempty,
hscolourVerbosity = mempty
}
mappend a b = HscolourFlags {
hscolourCSS = combine hscolourCSS,
hscolourExecutables = combine hscolourExecutables,
hscolourTestSuites = combine hscolourTestSuites,
hscolourBenchmarks = combine hscolourBenchmarks,
hscolourDistPref = combine hscolourDistPref,
hscolourVerbosity = combine hscolourVerbosity
}
......@@ -1035,6 +1046,26 @@ hscolourCommand = makeCommand name shortDesc longDesc
hscolourExecutables (\v flags -> flags { hscolourExecutables = v })
trueArg
,option "" ["tests"]
"Run hscolour for Test Suite targets"
hscolourTestSuites (\v flags -> flags { hscolourTestSuites = v })
trueArg
,option "" ["benchmarks"]
"Run hscolour for Benchmark targets"
hscolourBenchmarks (\v flags -> flags { hscolourBenchmarks = v })
trueArg
,option "" ["all"]
"Run hscolour for all targets"
(\f -> allFlags [ hscolourExecutables f
, hscolourTestSuites f
, hscolourBenchmarks f])
(\v flags -> flags { hscolourExecutables = v
, hscolourTestSuites = v
, hscolourBenchmarks = v })
trueArg
,option "" ["css"]
"Use a cascading style sheet"
hscolourCSS (\v flags -> flags { hscolourCSS = v })
......@@ -1052,6 +1083,8 @@ data HaddockFlags = HaddockFlags {
haddockHtml :: Flag Bool,
haddockHtmlLocation :: Flag String,
haddockExecutables :: Flag Bool,
haddockTestSuites :: Flag Bool,
haddockBenchmarks :: Flag Bool,
haddockInternal :: Flag Bool,
haddockCss :: Flag FilePath,
haddockHscolour :: Flag Bool,
......@@ -1071,6 +1104,8 @@ defaultHaddockFlags = HaddockFlags {
haddockHtml = Flag False,
haddockHtmlLocation = NoFlag,
haddockExecutables = Flag False,
haddockTestSuites = Flag False,
haddockBenchmarks = Flag False,
haddockInternal = Flag False,
haddockCss = NoFlag,
haddockHscolour = Flag False,
......@@ -1119,6 +1154,26 @@ haddockCommand = makeCommand name shortDesc longDesc defaultHaddockFlags options
haddockExecutables (\v flags -> flags { haddockExecutables = v })
trueArg
,option "" ["tests"]
"Run haddock for Test Suite targets"
haddockTestSuites (\v flags -> flags { haddockTestSuites = v })
trueArg
,option "" ["benchmarks"]
"Run haddock for Benchmark targets"
haddockBenchmarks (\v flags -> flags { haddockBenchmarks = v })
trueArg
,option "" ["all"]
"Run haddock for all targets"
(\f -> allFlags [ haddockExecutables f
, haddockTestSuites f
, haddockBenchmarks f])
(\v flags -> flags { haddockExecutables = v
, haddockTestSuites = v
, haddockBenchmarks = v })
trueArg
,option "" ["internal"]
"Run haddock for internal modules and include all symbols"
haddockInternal (\v flags -> flags { haddockInternal = v })
......@@ -1167,6 +1222,8 @@ instance Monoid HaddockFlags where
haddockHtml = mempty,
haddockHtmlLocation = mempty,
haddockExecutables = mempty,
haddockTestSuites = mempty,
haddockBenchmarks = mempty,
haddockInternal = mempty,
haddockCss = mempty,
haddockHscolour = mempty,
......@@ -1183,6 +1240,8 @@ instance Monoid HaddockFlags where
haddockHtml = combine haddockHoogle,
haddockHtmlLocation = combine haddockHtmlLocation,
haddockExecutables = combine haddockExecutables,
haddockTestSuites = combine haddockTestSuites,
haddockBenchmarks = combine haddockBenchmarks,
haddockInternal = combine haddockInternal,
haddockCss = combine haddockCss,
haddockHscolour = combine haddockHscolour,
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment