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|
|]
renderImplRefRow :: ImplementationChangeReference -> Html
renderImplRefRow ref = [hsx|
Impl Ref
{ref.workItemRef}
({ref.system})
|]
renderRequirementRow :: Requirement -> Html
renderRequirementRow req = [hsx|
|]
renderCandidateRow :: RequirementCandidate -> Html
renderCandidateRow c = [hsx|
|]
renderWidgetRow :: Widget -> Html
renderWidgetRow w = [hsx|
|]
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|
|]
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)
| Metric |
Before |
After |
Delta |
{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}
|]
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)