{-# LANGUAGE RecordWildCards #-} module Distribution.Server.Features.BuildReports.Render ( renderBuildStatus ) where import Distribution.Server.Framework import Distribution.Server.Features.BuildReports import Distribution.Server.Features.BuildReports.BuildReports (BuildReportId) import Distribution.Server.Features.BuildReports.BuildReport (BuildReport(..), InstallOutcome(..), Outcome(..)) import Distribution.Server.Features.Documentation import Distribution.Package import Text.XHtml.Strict import Control.Arrow ((&&&)) import Data.Foldable (foldMap) import Data.List (sortBy, maximumBy) import Data.Ord (comparing) import Data.Time (UTCTime(utctDay), showGregorian) data BuildStatus = BuildStatus { rendDocsReport :: Maybe (BuildReportId, BuildReport), rendBuildability :: Maybe (Bool, Maybe UTCTime), rendNumReports :: Int } deriving (Show) renderBuildStatus :: MonadIO m => DocumentationFeature -> ReportsFeature -> PackageId -> m Html renderBuildStatus DocumentationFeature{..} ReportsFeature{..} pkgid = do hasDocs <- queryHasDocumentation pkgid reports <- queryPackageReports pkgid return $ render reportsResource pkgid hasDocs (summarize reports) summarize :: [(BuildReportId, BuildReport)] -> BuildStatus summarize unsortedReports = BuildStatus{..} where -- Order the reports from oldest to newest. As maximumBy favors later -- elements, this will ensure we pick the most recent report. allReports = sortBy (comparing fst) unsortedReports -- When determining the doc status, only use reports generated by the server docReports = filter (docBuilder . snd) allReports rendDocsReport | null docReports = Nothing | otherwise = Just $ maximumBy (comparing (docsOutcome . snd)) docReports rendBuildability | null allReports = Nothing | otherwise = Just $ (isSuccess &&& time) . snd $ maximumBy (comparing (isSuccess . snd)) allReports where isSuccess BuildReport{..} = installOutcome == InstallOk && testsOutcome /= Failed rendNumReports = length allReports render :: ReportsResource -> PackageId -> Bool -> BuildStatus -> Html render ReportsResource{..} pkgid hasDocs BuildStatus{..} = mconcat [ docsStatus , reportLink , br , buildStatus , reportsLink ] where docsStatus = toHtml $ case hasDocs of False -> case rendDocsReport of Nothing -> "Docs pending" Just _ -> "Docs not available" True -> case rendDocsReport of Just (_, BuildReport{ docsOutcome = Ok }) -> "Docs available" _ -> "Docs uploaded by user" reportLink = foldMap link rendDocsReport where link (repid, _) = (" " +++) . enclose $ anchor ! [href $ reportsPageUri "" pkgid repid] << "build log" buildStatus = toHtml $ case rendBuildability of Nothing -> "Build status unknown" Just (False, mtime) -> "All reported builds failed" ++ foldMap (\tm -> " as of " ++ showDate tm) mtime Just (True, Nothing) -> "Successful builds reported" Just (True, Just tm) -> "Last success reported on " ++ showDate tm where showDate = showGregorian . utctDay reportsLink = (" " +++) . enclose $ anchor ! [href $ reportsListUri "" pkgid] << if rendNumReports > 0 then "all " ++ show rendNumReports ++ " reports" else "no reports yet" enclose item = thespan ! [thestyle "font-size: small"] << ("[" +++ item +++ "]")