Render.hs

{-# 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 +++ "]")