BuildReports.hs

-- Generate an HTML page listing all build reports for a package

module Distribution.Server.Pages.BuildReports (
  buildReportSummary,
  buildReportDetail,
  ) where

import qualified Distribution.Server.Features.BuildReports.BuildReport as BuildReport
import Distribution.Server.Features.BuildReports.BuildReport (BuildReport)
import Distribution.Server.Features.BuildReports.BuildReports
import Distribution.Server.Pages.Template ( hackagePage )

import Distribution.Package
         ( PackageIdentifier )
import Distribution.PackageDescription
         ( FlagName(FlagName) )
import Distribution.Text
         ( Text, display )

import qualified Text.XHtml.Strict as XHtml
import Text.XHtml.Strict
         ( Html, (<<), (!), tr, th, td, p, h2, ulist, li
         , toHtml, table, theclass, concatHtml, isNoHtml )
import Data.List (intersperse)

buildReportSummary :: PackageIdentifier
                   -> [(BuildReportId, BuildReport)] -> XHtml.Html
buildReportSummary pkgid reports = hackagePage title body
  where
    title = display pkgid ++ ": build reports"
    body  = [h2 << title, summaryTable]

    summaryTable = XHtml.table ! [theclass "properties"] <<
                    (headerRow : dataRows)
    headerRow = tr << [ th ! [XHtml.theclass "horizontal"] <<
                          columnName
                      | columnName <- columnNames ]
    columnNames = ["Platform", "Compiler", "Build outcome"]
    dataRows =
      [ tr ! [theclass (if odd n then "odd" else "even")] <<
          [ td << (display (BuildReport.arch report)
                ++ " / "
                ++ display (BuildReport.os report))
          , td << display (BuildReport.compiler report)
          , td << detailLink reportId <<
                    display (BuildReport.installOutcome report) ]
      | (n, (reportId, report)) <- zip [(1::Int)..] reports ]
    detailLink reportId =
      XHtml.anchor ! [XHtml.href $ "/buildreports/" ++ display reportId ]

buildReportDetail :: BuildReport -> BuildReportId -> Maybe BuildLog -> XHtml.Html
buildReportDetail report reportId buildLog = hackagePage title body
  where
    title = display pkgid ++ ": build report"
    pkgid = BuildReport.package report
    body  = [h2 << title, details, buildLogPara]
    details = tabulate
            [ (name, value)
            | (name, field) <- showFields
            , let value = field report
            , not (isNoHtml value) ]

    buildLogPara = p << [ ulist << [li << buildLogLink]]
    buildLogLink = case buildLog of
      Nothing -> toHtml "No build log available"
      _       -> XHtml.anchor ! [XHtml.href buildLogURL ] << "Build log"
    buildLogURL  = "/buildreports/" ++ display reportId ++ "/buildlog"

    showFields :: [(String, BuildReport -> Html)]
    showFields =
      [ ("Package",             displayHtml      . BuildReport.package)
      , ("Platform",            toHtml           . platform)
      , ("Compiler",            displayHtml      . BuildReport.compiler)
      , ("Build client",        displayHtml      . BuildReport.client)
      , ("Configuration flags", displayHtmlFlags . BuildReport.flagAssignment)
      , ("Exact dependencies",  displayHtmlList  . BuildReport.dependencies)
      , ("Install outcome",     displayHtml      . BuildReport.installOutcome)
      , ("Docs outcome",        displayHtml      . BuildReport.docsOutcome)
      ]
    platform report' = display (BuildReport.arch report')
                    ++ " / "
                    ++ display (BuildReport.os report')
    displayHtml     :: Text a => a -> Html
    displayHtml     = toHtml . display
    displayHtmlList :: Text a => [a] -> Html
    displayHtmlList  = concatHtml . intersperse (toHtml ", ") . map displayHtml
    displayHtmlFlags = concatHtml . intersperse (toHtml ", ") . map displayFlag
    displayFlag (FlagName fname, False) = toHtml $ '-':fname
    displayFlag (FlagName fname, True)  = toHtml $     fname

tabulate :: [(String, Html)] -> Html
tabulate items = table ! [theclass "properties"] <<
	[tr ! [theclass (if odd n then "odd" else "even")] <<
		[th ! [theclass "horizontal"] << t, td << d] |
		(n, (t, d)) <- zip [(1::Int)..] items]