Commit 3c1a0243 authored by Duncan Coutts's avatar Duncan Coutts

Rearrange user interface for build logging

The new options (as described in ticket #501) are:
  --build-summary=TEMPLATE
  --build-log=TEMPLATE
  --remote-build-reporting=LEVEL
  where LELVEL `elem` [none,anonymous,detailed]
parent 2f414860
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.BuildReports.Types
-- Copyright : (c) Duncan Coutts 2009
-- License : BSD-like
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- Types related to build reporting
--
-----------------------------------------------------------------------------
module Distribution.Client.BuildReports.Types (
ReportLevel(..),
) where
import qualified Distribution.Text as Text
( Text(disp, parse) )
import qualified Distribution.Compat.ReadP as Parse
( pfail, munch1 )
import qualified Text.PrettyPrint.HughesPJ as Disp
( text )
import Data.Char as Char
( isAlpha, toLower )
data ReportLevel = NoReports | AnonymousReports | DetailedReports
deriving (Eq, Ord, Show)
instance Text.Text ReportLevel where
disp NoReports = Disp.text "none"
disp AnonymousReports = Disp.text "anonymous"
disp DetailedReports = Disp.text "detailed"
parse = do
name <- Parse.munch1 Char.isAlpha
case lowercase name of
"none" -> return NoReports
"anonymous" -> return AnonymousReports
"detailed" -> return DetailedReports
_ -> Parse.pfail
lowercase :: String -> String
lowercase = map Char.toLower
......@@ -58,6 +58,8 @@ import Distribution.Client.Types as Available
, Repo(..), ConfiguredPackage(..)
, BuildResult, BuildFailure(..), BuildSuccess(..)
, DocsResult(..), TestsResult(..), RemoteRepo(..) )
import Distribution.Client.BuildReports.Types
( ReportLevel(..) )
import Distribution.Client.SetupWrapper
( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
import qualified Distribution.Client.BuildReports.Anonymous as BuildReports
......@@ -84,7 +86,7 @@ import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Utils
( defaultPackageDesc, rawSystemExit, comparing )
import Distribution.Simple.InstallDirs
( fromPathTemplate, toPathTemplate
( PathTemplate, fromPathTemplate, toPathTemplate
, initialPathTemplateEnv, substPathTemplate )
import Distribution.Package
( PackageName, PackageIdentifier, packageName, packageVersion
......@@ -237,17 +239,20 @@ installWithPlanner planner verbosity packageDB repos comp conf
useLoggingHandle = Nothing,
useWorkingDir = Nothing
}
useDetailedBuildReports = fromFlagOrDefault False (installBuildReports installFlags)
useDetailedBuildReports = reportingLevel == DetailedReports
reportingLevel = fromFlagOrDefault NoReports (installBuildReports installFlags)
useLogFile :: FilePath -> Maybe (PackageIdentifier -> FilePath)
useLogFile logsDir = fmap substLogFileName logFileTemplate
where
logFileTemplate
| useDetailedBuildReports = Just $ logsDir </> "$pkgid" <.> "log"
| otherwise = flagToMaybe (installLogFile installFlags)
substLogFileName path pkg = fromPathTemplate
. substPathTemplate env
. toPathTemplate
$ path
logFileTemplate :: Maybe PathTemplate
logFileTemplate --TODO: separate policy from mechanism
| reportingLevel == DetailedReports
= Just $ toPathTemplate $ logsDir </> "$pkgid" <.> "log"
| otherwise
= flagToMaybe (installLogFile installFlags)
substLogFileName template pkg = fromPathTemplate
. substPathTemplate env
$ template
where env = initialPathTemplateEnv (packageId pkg) (compilerId comp)
dryRun = fromFlagOrDefault False (installDryRun installFlags)
miscOptions = InstallMisc {
......
......@@ -34,6 +34,8 @@ module Distribution.Client.Setup
import Distribution.Client.Types
( Username(..), Password(..), Repo(..), RemoteRepo(..), LocalRepo(..) )
import Distribution.Client.BuildReports.Types
( ReportLevel(..) )
import Distribution.Simple.Program
( defaultProgramConfiguration )
......@@ -48,6 +50,8 @@ import Distribution.Simple.Setup
, optionVerbosity, trueArg )
import Distribution.Simple.Compiler
( PackageDB(..) )
import Distribution.Simple.InstallDirs
( PathTemplate, toPathTemplate, fromPathTemplate )
import Distribution.Version
( Version(Version), VersionRange(..) )
import Distribution.Package
......@@ -459,8 +463,9 @@ data InstallFlags = InstallFlags {
installReinstall :: Flag Bool,
installOnly :: Flag Bool,
installRootCmd :: Flag String,
installLogFile :: Flag FilePath,
installBuildReports :: Flag Bool,
installSummaryFile :: [PathTemplate],
installLogFile :: Flag PathTemplate,
installBuildReports :: Flag ReportLevel,
installSymlinkBinDir:: Flag FilePath
}
......@@ -471,8 +476,9 @@ defaultInstallFlags = InstallFlags {
installReinstall = Flag False,
installOnly = Flag False,
installRootCmd = mempty,
installSummaryFile = mempty,
installLogFile = mempty,
installBuildReports = Flag False,
installBuildReports = Flag NoReports,
installSymlinkBinDir= mempty
}
......@@ -533,15 +539,24 @@ installOptions showOrParseArgs =
installSymlinkBinDir (\v flags -> flags { installSymlinkBinDir = v })
(reqArgFlag "DIR")
, option [] ["log-builds"]
, option [] ["build-summary"]
"Save build summaries to file (name template can use $pkgid, $compiler, $os, $arch)"
installSummaryFile (\v flags -> flags { installSummaryFile = v })
(reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) (map fromPathTemplate))
, option [] ["build-log"]
"Log all builds to file (name template can use $pkgid, $compiler, $os, $arch)"
installLogFile (\v flags -> flags { installLogFile = v })
(reqArg' "FILE" toFlag flagToList)
(reqArg' "TEMPLATE" (toFlag.toPathTemplate)
(flagToList . fmap fromPathTemplate))
, option [] ["build-reports"]
"Generate detailed build reports. (overrides --log-builds)"
, option [] ["remote-build-reporting"]
"Generate build reports to send to a remote server (none, anonymous or detailed)."
installBuildReports (\v flags -> flags { installBuildReports = v })
trueArg
(reqArg "LEVEL" (readP_to_E (const $ "report level must be 'none', "
++ "'anonymous' or 'detailed'")
(toFlag `fmap` parse))
(flagToList . fmap display))
] ++ case showOrParseArgs of -- TODO: remove when "cabal install" avoids
ParseArgs ->
......@@ -559,6 +574,7 @@ instance Monoid InstallFlags where
installReinstall = mempty,
installOnly = mempty,
installRootCmd = mempty,
installSummaryFile = mempty,
installLogFile = mempty,
installBuildReports = mempty,
installSymlinkBinDir= mempty
......@@ -569,6 +585,7 @@ instance Monoid InstallFlags where
installReinstall = combine installReinstall,
installOnly = combine installOnly,
installRootCmd = combine installRootCmd,
installSummaryFile = combine installSummaryFile,
installLogFile = combine installLogFile,
installBuildReports = combine installBuildReports,
installSymlinkBinDir= combine installSymlinkBinDir
......
Markdown is supported
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