module Web.View.DeploymentRecords.Show where import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude import Web.Routes () import Data.Int (Int16) data PeriodMetrics = PeriodMetrics { eventCount :: !Int , annotationCount :: !Int , lowCount :: !Int , mediumCount :: !Int , highCount :: !Int , criticalCount :: !Int } highCriticalRate :: PeriodMetrics -> Double highCriticalRate m | m.annotationCount == 0 = 0 | otherwise = fromIntegral (m.highCount + m.criticalCount) / fromIntegral m.annotationCount data ShowView = ShowView { record :: !DeploymentRecord , decision :: !DecisionRecord , mImplRef :: !(Maybe ImplementationChangeReference) , mRequirement :: !(Maybe Requirement) , mCandidate :: !(Maybe RequirementCandidate) , mWidget :: !(Maybe Widget) , signals :: ![OutcomeSignal] , mEvaluation :: !(Maybe ChangeEvaluation) , users :: ![User] , comparison :: !(Maybe (PeriodMetrics, PeriodMetrics)) } instance View ShowView where html ShowView { .. } = [hsx|
Deployments / {record.versionRef}

{record.versionRef}

Deployed at: {show record.deployedAt} · Deployed by: {userName users record.deployedBy}
{maybe mempty renderNotes record.notes}

Decision Chain

Decision {decision.title} " text-xs px-2 py-0.5 rounded font-medium"}> {decision.outcome}
{maybe mempty renderImplRefRow mImplRef} {maybe mempty renderRequirementRow mRequirement} {maybe mempty renderCandidateRow mCandidate} {maybe mempty renderWidgetRow mWidget}

Outcome Signals

{renderSignalsSection signals}

Change Evaluation

{maybe (renderNoEvaluationForm record.id) renderEvaluation mEvaluation}
{maybe mempty renderComparison comparison}
|] renderNotes :: Text -> Html renderNotes notes = [hsx|

Notes

{notes}

|] renderImplRefRow :: ImplementationChangeReference -> Html renderImplRefRow ref = [hsx|
Impl Ref {ref.workItemRef} ({ref.system})
|] renderRequirementRow :: Requirement -> Html renderRequirementRow req = [hsx|
Requirement {req.title}
|] renderCandidateRow :: RequirementCandidate -> Html renderCandidateRow c = [hsx|
Candidate {c.title}
|] renderWidgetRow :: Widget -> Html renderWidgetRow w = [hsx|
Widget {w.name}
|] renderSignalsSection :: [OutcomeSignal] -> Html renderSignalsSection [] = [hsx|

No signals recorded yet.

|] renderSignalsSection sigs = [hsx|
{forEach sigs renderSignal}
|] renderSignal :: OutcomeSignal -> Html renderSignal sig = [hsx|
" text-xs px-2 py-0.5 rounded font-medium"}> {sig.signalType} {maybe mempty renderSignalValue sig.value} {show sig.observedAt}
|] renderSignalValue :: Double -> Html renderSignalValue v = [hsx| {show v} |] renderNoEvaluationForm :: Id DeploymentRecord -> Html renderNoEvaluationForm deploymentRecordId = [hsx|
{hiddenField "authenticity_token"}
|] renderEvaluation :: ChangeEvaluation -> Html renderEvaluation ev = [hsx|
" text-base px-2 py-0.5 rounded font-medium"}> {starsFor ev.score}

{ev.rationale}

{show ev.evaluatedAt}

|] renderComparison :: (PeriodMetrics, PeriodMetrics) -> Html renderComparison (before, after) = [hsx|

Pre/Post Comparison (±30 days)

{renderMetricRow "Interaction events" before.eventCount after.eventCount False} {renderMetricRow "Annotations (total)" before.annotationCount after.annotationCount True} {renderMetricRow "— low severity" before.lowCount after.lowCount True} {renderMetricRow "— medium severity" before.mediumCount after.mediumCount True} {renderMetricRow "— high severity" before.highCount after.highCount True} {renderMetricRow "— critical severity" before.criticalCount after.criticalCount True} {renderRateRow before after}
Metric Before After Delta
|] renderMetricRow :: Text -> Int -> Int -> Bool -> Html renderMetricRow label b a lowerIsBetter = [hsx| {label} {showNA b} {showNA a} {showDelta (a - b)} |] where showNA n = if n == 0 then "—" else show n showDelta d | d == 0 = "—" | d > 0 = "+" <> show d | otherwise = show d renderRateRow :: PeriodMetrics -> PeriodMetrics -> Html renderRateRow before after = [hsx| High/critical rate {formatRate (highCriticalRate before)} {formatRate (highCriticalRate after)} {formatRateDelta (highCriticalRate after - highCriticalRate before)} |] where formatRate r = show (round (r * 100) :: Int) <> "%" formatRateDelta d | abs d < 0.001 = "—" | d > 0 = "+" <> show (round (d * 100) :: Int) <> "%" | otherwise = show (round (d * 100) :: Int) <> "%" deltaClass :: Int -> Bool -> Text deltaClass 0 _ = "text-gray-400" deltaClass d True | d < 0 = "text-green-600 font-medium" | otherwise = "text-red-600 font-medium" deltaClass d False | d > 0 = "text-green-600 font-medium" | otherwise = "text-red-600 font-medium" rateClass :: Double -> Double -> Text rateClass after before | abs (after - before) < 0.001 = "text-gray-400" | after < before = "text-green-600 font-medium" | otherwise = "text-red-600 font-medium" signalTypeClass :: Text -> Text signalTypeClass "improved" = "bg-green-100 text-green-800" signalTypeClass "regressed" = "bg-red-100 text-red-800" signalTypeClass "neutral" = "bg-gray-100 text-gray-600" signalTypeClass "inconclusive" = "bg-yellow-100 text-yellow-800" signalTypeClass _ = "bg-gray-100 text-gray-600" 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" starsFor :: Int16 -> Text starsFor n = pack (Prelude.replicate (fromIntegral n) '★') <> pack (Prelude.replicate (5 - fromIntegral n) '☆') userName :: [User] -> Maybe (Id User) -> Text userName _ Nothing = "—" userName users (Just uid) = maybe "(unknown)" (.name) (find (\u -> u.id == uid) users)