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}

Triage Governance Hub
{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| {forEach deploys (renderDeployRow decisions signals evals)}
Version Decision Signals Eval Deployed
|] renderRecurrenceSection :: [(Id Widget, Int)] -> [Widget] -> Html renderRecurrenceSection [] _ = [hsx|

No recurring widgets detected.

|] renderRecurrenceSection leaderboard widgets = [hsx| {forEach leaderboard (renderRecurrenceRow widgets)}
Widget Cycles
|] 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"