Skip to content

Commit

Permalink
Don't output haddock stdout if verbosity is silent
Browse files Browse the repository at this point in the history
  • Loading branch information
lukel97 committed Jun 8, 2020
1 parent 0dff8a6 commit 36d8e1d
Show file tree
Hide file tree
Showing 4 changed files with 45 additions and 2 deletions.
4 changes: 3 additions & 1 deletion Cabal/Distribution/Simple/Haddock.hs
Original file line number Diff line number Diff line change
Expand Up @@ -559,7 +559,9 @@ runHaddock verbosity tmpFileOpts comp platform haddockProg args
renderArgs verbosity tmpFileOpts haddockVersion comp platform args $
\(flags,result)-> do

runProgram verbosity haddockProg flags
haddockOut <- getProgramOutput verbosity haddockProg flags
unless (verbosity <= silent) $
putStr haddockOut

notice verbosity $ "Documentation created: " ++ result

Expand Down
1 change: 1 addition & 0 deletions cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out
Original file line number Diff line number Diff line change
Expand Up @@ -12,4 +12,5 @@ In order, the following will be built:
- example-1.0 (lib) (first run)
Preprocessing library for example-1.0..
Running Haddock on library for example-1.0..
cabal: '<HADDOCK>' exited with an error:
cabal: Failed to build documentation for example-1.0-inplace.
10 changes: 9 additions & 1 deletion cabal-testsuite/src/Test/Cabal/Monad.hs
Original file line number Diff line number Diff line change
Expand Up @@ -411,6 +411,10 @@ mkNormalizerEnv = do
list_out <- liftIO $ readProcess (programPath ghc_pkg_program)
["list", "--global", "--simple-output"] ""
tmpDir <- liftIO $ getTemporaryDirectory
haddock <- let prog = fromJust $ lookupKnownProgram "haddock" (testProgramDb env)
in fmap (fst . fromJust) $ liftIO $
programFindLocation prog (testVerbosity env)
[ProgramSearchPathDefault]
return NormalizerEnv {
normalizerRoot
= addTrailingPathSeparator (testSourceDir env),
Expand All @@ -423,8 +427,12 @@ mkNormalizerEnv = do
normalizerKnownPackages
= mapMaybe simpleParse (words list_out),
normalizerPlatform
= testPlatform env
= testPlatform env,
normalizerHaddock
= haddock
}
where


requireProgramM :: Program -> TestM ConfiguredProgram
requireProgramM program = do
Expand Down
32 changes: 32 additions & 0 deletions cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ import Distribution.System
import qualified Data.Foldable as F

import Text.Regex
import Data.List

normalizeOutput :: NormalizerEnv -> String -> String
normalizeOutput nenv =
Expand Down Expand Up @@ -54,18 +55,49 @@ normalizeOutput nenv =
else id)
-- hackage-security locks occur non-deterministically
. resub "(Released|Acquired|Waiting) .*hackage-security-lock\n" ""
-- Substitute the haddock binary with <HADDOCK>
-- Do this before the <GHCVER> substitution
. resub (posixRegexEscape (normalizerHaddock nenv)) "<HADDOCK>"
. removeErrors
where
packageIdRegex pid =
resub (posixRegexEscape (display pid) ++ "(-[A-Za-z0-9.-]+)?")
(prettyShow (packageName pid) ++ "-<VERSION>")

{- Given
cabal: blah exited with an error:
Example.hs:6:11: error:
* Couldn't match expected type `Int' with actual type `Bool'
* In the expression: False
In an equation for `example': example = False
|
6 | example = False
| ^^^^^
cabal: Failed to build documentation for example-1.0-inplace.
this will remove the error in between the first line with "exited with an error"
and the closing "cabal:". Pretty nasty, but its needed to ignore errors from
external programs whose output might change.
-}
removeErrors :: String -> String
removeErrors s = unlines (go (lines s) False)
where
go [] _ = []
go (x:xs) True
| "cabal:" `isPrefixOf` x = x:(go xs False)
| otherwise = go xs True
go (x:xs) False
| "exited with an error" `isInfixOf` x = x:(go xs True)
| otherwise = x:(go xs False)

data NormalizerEnv = NormalizerEnv
{ normalizerRoot :: FilePath
, normalizerTmpDir :: FilePath
, normalizerGblTmpDir :: FilePath
, normalizerGhcVersion :: Version
, normalizerKnownPackages :: [PackageId]
, normalizerPlatform :: Platform
, normalizerHaddock :: FilePath
}

posixSpecialChars :: [Char]
Expand Down

0 comments on commit 36d8e1d

Please sign in to comment.