module Web.View.Hubs.AntifragilityDashboard where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data AntifragilityDashboardView = AntifragilityDashboardView
{ hub :: !Hub
, widgets :: ![Widget]
, allDeployments :: ![DeploymentRecord]
, allDecisions :: ![DecisionRecord]
, allSignals :: ![OutcomeSignal]
, allEvaluations :: ![ChangeEvaluation]
, allImplRefs :: ![ImplementationChangeReference]
, regressionWidgetIds :: ![Id Widget]
, recurrenceLeaderboard :: ![(Id Widget, Int)]
}
instance View AntifragilityDashboardView where
html AntifragilityDashboardView { .. } = [hsx|
Hubs
/
{hub.name}
/
Antifragility
Antifragility Dashboard — {hub.name}
{show (length allDeployments)}
deployments
{avgScoreText}
avg evaluation
{improvedPctText}
improved signals
{show (length regressionWidgetIds)}
regressions
{if null regressionWidgetIds then mempty else renderRegressionAlerts regressedWidgets}
Open Gaps
(decisions with impl refs but no deployment recorded)
{renderOpenGaps openGaps}
Recent Deployments
{renderRecentDeploysSection recentDeploys allDecisions allSignals allEvaluations}
Recurrence Leaderboard
{renderRecurrenceSection recurrenceLeaderboard widgets}
|]
where
deployedIds = map (.id) allDeployments
openGaps = filter (\d -> any (\r -> r.decisionId == d.id) allImplRefs
&& not (any (\dp -> dp.decisionId == d.id) allDeployments))
allDecisions
recentDeploys = take 20 (sortByDesc (.deployedAt) allDeployments)
regressedWidgets = filter (\w -> w.id `elem` regressionWidgetIds) widgets
avgScoreText
| null allEvaluations = "—"
| otherwise =
let avg = fromIntegral (sum (map (.score) allEvaluations)) / fromIntegral (length allEvaluations) :: Double
in show (round avg :: Int) <> "/5"
improvedPctText
| null allSignals = "—"
| otherwise =
let improved = length (filter (\s -> s.signalType == "improved") allSignals)
pct = (fromIntegral improved * 100 `div` length allSignals) :: Int
in show pct <> "%"
sortByDesc :: Ord b => (a -> b) -> [a] -> [a]
sortByDesc f = sortBy (\a b -> compare (f b) (f a))
renderRegressedBadge :: Widget -> Html
renderRegressedBadge w = [hsx|
{w.name}
|]
renderGapRow :: DecisionRecord -> Html
renderGapRow d = [hsx|
{d.title}
" text-xs px-2 py-0.5 rounded font-medium"}>
{d.outcome}
|]
renderDeployRow :: [DecisionRecord] -> [OutcomeSignal] -> [ChangeEvaluation] -> DeploymentRecord -> Html
renderDeployRow decisions signals evals dr = [hsx|
|
{dr.versionRef}
|
{decisionTitle} |
{renderSignalSummary drSignals}
|
{maybe noEvalBadge renderEvalBadge mScore}
|
{show dr.deployedAt} |
|]
where
decisionTitle = maybe "—" (.title) (find (\d -> d.id == dr.decisionId) decisions)
drSignals = filter (\s -> s.deploymentId == dr.id) signals
mScore = fmap (.score) (find (\e -> e.deploymentId == dr.id) evals)
renderSignalSummary :: [OutcomeSignal] -> Html
renderSignalSummary [] = [hsx|—|]
renderSignalSummary signals = [hsx|
{forEach (take 3 signals) renderSignalDot}
|]
signalDot :: Text -> Text
signalDot "improved" = "inline-block w-2 h-2 rounded-full bg-green-500"
signalDot "regressed" = "inline-block w-2 h-2 rounded-full bg-red-500"
signalDot "neutral" = "inline-block w-2 h-2 rounded-full bg-gray-400"
signalDot "inconclusive" = "inline-block w-2 h-2 rounded-full bg-yellow-400"
signalDot _ = "inline-block w-2 h-2 rounded-full bg-gray-300"
renderEvalBadge :: Int16 -> Html
renderEvalBadge score = [hsx|
" text-xs px-2 py-0.5 rounded font-medium"}>
{show score}/5
|]
renderRecurrenceRow :: [Widget] -> (Id Widget, Int) -> Html
renderRecurrenceRow widgets (wid, count) = [hsx|
|
{maybe noWidgetSpan renderWidgetLink mWidget}
|
⟳ {show count}
|
|]
where
mWidget = find (\w -> w.id == wid) widgets
renderWidgetLink :: Widget -> Html
renderWidgetLink w = [hsx|
{w.name}
|]
renderRegressionAlerts :: [Widget] -> Html
renderRegressionAlerts ws = [hsx|
⚠ Regression Alerts
{forEach ws renderRegressedBadge}
|]
renderOpenGaps :: [DecisionRecord] -> Html
renderOpenGaps [] = [hsx|All decisions with impl refs have deployments.
|]
renderOpenGaps gaps = [hsx|
{forEach gaps renderGapRow}
|]
renderRecentDeploysSection :: [DeploymentRecord] -> [DecisionRecord] -> [OutcomeSignal] -> [ChangeEvaluation] -> Html
renderRecentDeploysSection [] _ _ _ = [hsx|No deployments yet.
|]
renderRecentDeploysSection deploys decisions signals evals = [hsx|
| Version |
Decision |
Signals |
Eval |
Deployed |
{forEach deploys (renderDeployRow decisions signals evals)}
|]
renderRecurrenceSection :: [(Id Widget, Int)] -> [Widget] -> Html
renderRecurrenceSection [] _ = [hsx|No recurring widgets detected.
|]
renderRecurrenceSection leaderboard widgets = [hsx|
| Widget |
Cycles |
{forEach leaderboard (renderRecurrenceRow widgets)}
|]
noEvalBadge :: Html
noEvalBadge = [hsx|—|]
noWidgetSpan :: Html
noWidgetSpan = [hsx|—|]
renderSignalDot :: OutcomeSignal -> Html
renderSignalDot s = [hsx||]
outcomeClass :: Text -> Text
outcomeClass "accepted" = "bg-green-100 text-green-800"
outcomeClass "rejected" = "bg-red-100 text-red-800"
outcomeClass "deferred" = "bg-gray-100 text-gray-600"
outcomeClass "split" = "bg-purple-100 text-purple-800"
outcomeClass "merged" = "bg-indigo-100 text-indigo-800"
outcomeClass "reframed" = "bg-orange-100 text-orange-800"
outcomeClass _ = "bg-gray-100 text-gray-600"
scoreClass :: Int16 -> Text
scoreClass n
| n <= 2 = "bg-red-100 text-red-800"
| n == 3 = "bg-yellow-100 text-yellow-800"
| otherwise = "bg-green-100 text-green-800"