haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-03-11 11:16:34 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Reduce more verbosity

Browse Source
This commit is contained in:
Chris Done 2015-02-18 22:51:31 +01:00
parent 2ee501db9c
commit c551ad0cdc
1 changed files with 16 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
Stackage/ShakeBuild.hs
View File

@ -373,14 +373,14 @@ packageTarget env@Env{..} name plan = do
when exists (FP.removeFile logFile)) when exists (FP.removeFile logFile))
configure env name logFile dir plan configure env name logFile dir plan
prefix <- packageCmdPrefix name prefix <- packageCmdPrefix name
let pkgCabal :: (MonadIO m) => [String] -> m () let pkgCabal :: (MonadIO m) => Verbosity -> [String] -> m ()
pkgCabal = succeed . cabal env prefix logFile dir pkgCabal verbosity = succeed . cabal env verbosity prefix logFile dir
pkgCabal ["build","--ghc-options=" <> pbGhcOptions envPB] pkgCabal Normal ["build","--ghc-options=" <> pbGhcOptions envPB]
when (pbEnableTests envPB) when (pbEnableTests envPB)
(succeed (cabal env prefix logFile dir ["test"])) (succeed (cabal env Normal prefix logFile dir ["test"]))
pkgCabal ["copy"] pkgCabal Verbose ["copy"]
liftIO (withMVar envRegLock liftIO (withMVar envRegLock
(const (pkgCabal ["register"]))) (const (pkgCabal Verbose ["register"])))
makeTargetFile (targetForPackage envShake name version) makeTargetFile (targetForPackage envShake name version)
where logFile = (pkgLogFile env name version) where logFile = (pkgLogFile env name version)
dir = pkgDir env name version dir = pkgDir env name version
@ -420,7 +420,7 @@ unpack env@Env{..} name version = do
configure :: Env -> PackageName -> FilePath -> FilePath -> PackagePlan -> Action () configure :: Env -> PackageName -> FilePath -> FilePath -> PackagePlan -> Action ()
configure env@Env{..} name logfile pdir plan = configure env@Env{..} name logfile pdir plan =
do prefix <- packageCmdPrefix name do prefix <- packageCmdPrefix name
succeed (cabal env prefix logfile pdir ("configure" : opts)) succeed (cabal env Verbose prefix logfile pdir ("configure" : opts))
where where
opts = opts =
[ "--package-db=clear" [ "--package-db=clear"
@ -445,6 +445,7 @@ generateHaddocks env@Env{..} logfile pdir name version expected = do
exitCode <- exitCode <-
cabal cabal
env env
Normal
prefix prefix
logfile logfile
pdir pdir
@ -463,8 +464,11 @@ generateHaddocks env@Env{..} logfile pdir name version expected = do
, FP.encodeString hf]) , FP.encodeString hf])
(M.toList hfs)) (M.toList hfs))
case (exitCode, expected) of case (exitCode, expected) of
(ExitSuccess,ExpectFailure) -> return () -- FIXME: warn. (ExitSuccess,ExpectFailure) ->
(ExitFailure{},ExpectSuccess) -> throw exitCode -- FIXME: report it logLn env Normal (prefix <> "expected failure for haddock generation, but it succeeded!")
(ExitFailure{},ExpectSuccess) ->
do logLn env Normal (prefix <> "expected success for haddock, but it failed!")
throw exitCode -- FIXME: report it
_ -> return () _ -> return ()
copy copy
where where
@ -494,11 +498,11 @@ packageCmdPrefix name =
-- | Run a command with the right envornment, logs the command being -- | Run a command with the right envornment, logs the command being
-- run and its output as verbose mode. -- run and its output as verbose mode.
cabal :: MonadIO m => Env -> Text -> FilePath -> FilePath -> [String] -> m ExitCode cabal :: MonadIO m => Env -> Verbosity -> Text -> FilePath -> FilePath -> [String] -> m ExitCode
cabal env prefix logfile cwd args = do cabal env verbosity prefix logfile cwd args = do
pwd <- liftIO FP.getWorkingDirectory pwd <- liftIO FP.getWorkingDirectory
envmap <- liftIO $ fmap (++ defaultEnv (envPB env) pwd) $ getEnvironment envmap <- liftIO $ fmap (++ defaultEnv (envPB env) pwd) $ getEnvironment
logLn env Normal (prefix <> T.pack (fromMaybe "" (listToMaybe args)) <> " ...") logLn env verbosity (prefix <> T.pack (fromMaybe "" (listToMaybe args)))
logLn env Verbose (prefix <> T.pack (unwords (cmd' : map show args))) logLn env Verbose (prefix <> T.pack (unwords (cmd' : map show args)))
code <- liftIO $ flip catch exitFailing code <- liftIO $ flip catch exitFailing
$ withBinaryFile (FP.encodeString logfile) AppendMode $ \outH -> $ withBinaryFile (FP.encodeString logfile) AppendMode $ \outH ->