module Web.View.AnnotationThreads.Show where import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude data ShowView = ShowView { widget :: !Widget , thread :: !AnnotationThread , annotations :: ![Annotation] } instance View ShowView where html ShowView { .. } = [hsx|
{widget.name} / Threads / {thread.title}

{thread.title}

{maybe mempty (\d -> [hsx|

{d}

|]) thread.description}
{renderSeverityBar annotations} {dominantCategoryBadge annotations}
{forEach annotations renderAnnotationCard}
|] renderAnnotationCard :: Annotation -> Html renderAnnotationCard a = [hsx|
{a.category} " text-xs px-2 py-0.5 rounded"}> {a.severity}

{a.body}

|] renderSeverityBar :: [Annotation] -> Html renderSeverityBar annotations = let total = length annotations counts = map (\s -> (s, length $ filter (\a -> a.severity == s) annotations)) ["critical", "high", "medium", "low"] nonZero = filter (\(_, n) -> n > 0) counts in if total == 0 then mempty else [hsx|
{forEach nonZero (\(s, n) -> renderBarSegment s n total)}
|] renderBarSegment :: Text -> Int -> Int -> Html renderBarSegment sev n total = let pct = (n * 100) `div` total in [hsx|
" h-2 rounded"} style={"width: " <> show pct <> "px"} title={sev <> ": " <> show n}>
|] barColor :: Text -> Text barColor "low" = "bg-gray-300" barColor "medium" = "bg-blue-400" barColor "high" = "bg-yellow-400" barColor "critical" = "bg-red-500" barColor _ = "bg-gray-300" dominantCategoryBadge :: [Annotation] -> Text dominantCategoryBadge [] = "" dominantCategoryBadge annotations = let cats = map (.category) annotations tally = map (\c -> (c, length $ filter (== c) cats)) (nub cats) best = foldl1 (\(c1, n1) (c2, n2) -> if n2 > n1 then (c2, n2) else (c1, n1)) tally in fst best severityClass :: Text -> Text severityClass "low" = "bg-gray-100 text-gray-500" severityClass "medium" = "bg-blue-100 text-blue-700" severityClass "high" = "bg-yellow-100 text-yellow-800" severityClass "critical" = "bg-red-100 text-red-800 font-semibold" severityClass _ = "bg-gray-100 text-gray-500"