inter-hub-haskell/Web/View/DeploymentRecords/Show.hs

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|
        <div class="mb-6 flex items-center gap-2 text-sm text-gray-500">
            <a href={DeploymentRecordsAction} class="hover:text-gray-700">Deployments</a>
            <span>/</span>
            <span>{record.versionRef}</span>
        </div>

        <div class="max-w-3xl space-y-6">
            <!-- Header card -->
            <div class="bg-white rounded-lg border border-gray-200 px-6 py-5">
                <div class="flex items-start justify-between mb-3">
                    <h1 class="text-2xl font-semibold">{record.versionRef}</h1>
                </div>
                <div class="text-xs text-gray-400 mb-3">
                    Deployed at: {show record.deployedAt} ·
                    Deployed by: {userName users record.deployedBy}
                </div>
                {maybe mempty renderNotes record.notes}
            </div>

            <!-- Decision chain -->
            <div class="bg-white rounded-lg border border-gray-200 px-6 py-4">
                <h2 class="text-sm font-semibold text-gray-700 mb-3">Decision Chain</h2>
                <div class="space-y-2 text-sm">
                    <div class="flex items-center gap-2">
                        <span class="text-xs font-semibold text-gray-400 uppercase w-24">Decision</span>
                        <a href={ShowDecisionRecordAction (decision.id)}
                           class="text-indigo-600 hover:text-indigo-800">{decision.title}</a>
                        <span class={outcomeClass decision.outcome <> " text-xs px-2 py-0.5 rounded font-medium"}>
                            {decision.outcome}
                        </span>
                    </div>
                    {maybe mempty renderImplRefRow mImplRef}
                    {maybe mempty renderRequirementRow mRequirement}
                    {maybe mempty renderCandidateRow mCandidate}
                    {maybe mempty renderWidgetRow mWidget}
                </div>
            </div>

            <!-- Outcome signals -->
            <div class="bg-white rounded-lg border border-gray-200 px-6 py-4">
                <h2 class="text-sm font-semibold text-gray-700 mb-3">Outcome Signals</h2>
                {renderSignalsSection signals}
                <form method="POST" action={RecordOutcomeSignalAction (record.id)}
                      class="flex items-end gap-2 mt-2">
                    
                    <div>
                        <label class="text-xs text-gray-500 block mb-1">Signal type</label>
                        <select name="signalType"
                                class="text-sm border border-gray-300 rounded px-2 py-1.5">
                            <option value="improved">improved</option>
                            <option value="regressed">regressed</option>
                            <option value="neutral">neutral</option>
                            <option value="inconclusive">inconclusive</option>
                        </select>
                    </div>
                    <div>
                        <label class="text-xs text-gray-500 block mb-1">Value (0–100, optional)</label>
                        <input type="number" name="value" min="0" max="100" step="any"
                               class="w-24 text-sm border border-gray-300 rounded px-2 py-1.5"
                               placeholder="—" />
                    </div>
                    <button type="submit"
                            class="text-sm bg-gray-100 border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-200">
                        Record
                    </button>
                </form>
            </div>

            <!-- Change evaluation -->
            <div class="bg-white rounded-lg border border-gray-200 px-6 py-4">
                <h2 class="text-sm font-semibold text-gray-700 mb-3">Change Evaluation</h2>
                {maybe (renderNoEvaluationForm record.id) renderEvaluation mEvaluation}
            </div>

            <!-- Pre/post comparison -->
            {maybe mempty renderComparison comparison}
        </div>
    |]

renderNotes :: Text -> Html
renderNotes notes = [hsx|
    <div class="mt-2">
        <p class="text-xs font-semibold text-gray-500 uppercase tracking-wide mb-1">Notes</p>
        <p class="text-sm text-gray-600 italic">{notes}</p>
    </div>
|]

renderImplRefRow :: ImplementationChangeReference -> Html
renderImplRefRow ref = [hsx|
    <div class="flex items-center gap-2">
        <span class="text-xs font-semibold text-gray-400 uppercase w-24">Impl Ref</span>
        <span class="font-mono text-gray-700">{ref.workItemRef}</span>
        <span class="text-xs text-gray-400">({ref.system})</span>
    </div>
|]

renderRequirementRow :: Requirement -> Html
renderRequirementRow req = [hsx|
    <div class="flex items-center gap-2">
        <span class="text-xs font-semibold text-gray-400 uppercase w-24">Requirement</span>
        <a href={ShowRequirementAction (req.id)}
           class="text-indigo-600 hover:text-indigo-800">{req.title}</a>
    </div>
|]

renderCandidateRow :: RequirementCandidate -> Html
renderCandidateRow c = [hsx|
    <div class="flex items-center gap-2">
        <span class="text-xs font-semibold text-gray-400 uppercase w-24">Candidate</span>
        <a href={ShowRequirementCandidateAction (c.id)}
           class="text-indigo-600 hover:text-indigo-800">{c.title}</a>
    </div>
|]

renderWidgetRow :: Widget -> Html
renderWidgetRow w = [hsx|
    <div class="flex items-center gap-2">
        <span class="text-xs font-semibold text-gray-400 uppercase w-24">Widget</span>
        <a href={ShowWidgetAction (w.id)}
           class="text-indigo-600 hover:text-indigo-800">{w.name}</a>
    </div>
|]

renderSignalsSection :: [OutcomeSignal] -> Html
renderSignalsSection [] = [hsx|<p class="text-sm text-gray-400 mb-3">No signals recorded yet.</p>|]
renderSignalsSection sigs = [hsx|<div class="mb-4">{forEach sigs renderSignal}</div>|]

renderSignal :: OutcomeSignal -> Html
renderSignal sig = [hsx|
    <div class="flex items-center gap-3 py-2 border-b border-gray-100 last:border-0">
        <span class={signalTypeClass sig.signalType <> " text-xs px-2 py-0.5 rounded font-medium"}>
            {sig.signalType}
        </span>
        {maybe mempty renderSignalValue sig.value}
        <span class="text-xs text-gray-400 ml-auto">{show sig.observedAt}</span>
    </div>
|]

renderSignalValue :: Double -> Html
renderSignalValue v = [hsx|
    <span class="text-sm text-gray-700 font-mono">{show v}</span>
|]

renderNoEvaluationForm :: Id DeploymentRecord -> Html
renderNoEvaluationForm deploymentRecordId = [hsx|
    <form method="POST" action={EvaluateChangeAction deploymentRecordId}
          class="space-y-3">
        {hiddenField "authenticity_token"}
        <div>
            <label class="block text-xs font-medium text-gray-600 mb-1">
                Score (1–5) <span class="text-red-500">*</span>
            </label>
            <select name="score"
                    class="text-sm border border-gray-300 rounded px-3 py-1.5">
                <option value="1">1 ★☆☆☆☆ — very poor</option>
                <option value="2">2 ★★☆☆☆ — poor</option>
                <option value="3">3 ★★★☆☆ — neutral</option>
                <option value="4">4 ★★★★☆ — good</option>
                <option value="5">5 ★★★★★ — excellent</option>
            </select>
        </div>
        <div>
            <label class="block text-xs font-medium text-gray-600 mb-1">
                Rationale <span class="text-red-500">*</span>
            </label>
            <textarea name="rationale" rows="2" required
                      class="w-full text-sm border border-gray-300 rounded px-3 py-1.5"
                      placeholder="Why this score?"></textarea>
        </div>
        <button type="submit"
                class="text-sm bg-indigo-600 text-white px-4 py-1.5 rounded hover:bg-indigo-700">
            Evaluate
        </button>
    </form>
|]

renderEvaluation :: ChangeEvaluation -> Html
renderEvaluation ev = [hsx|
    <div class="space-y-2">
        <div class="flex items-center gap-2">
            <span class={scoreClass ev.score <> " text-base px-2 py-0.5 rounded font-medium"}>
                {starsFor ev.score}
            </span>
        </div>
        <p class="text-sm text-gray-700">{ev.rationale}</p>
        <p class="text-xs text-gray-400">{show ev.evaluatedAt}</p>
    </div>
|]

renderComparison :: (PeriodMetrics, PeriodMetrics) -> Html
renderComparison (before, after) = [hsx|
    <div class="bg-white rounded-lg border border-gray-200 px-6 py-4">
        <h2 class="text-sm font-semibold text-gray-700 mb-3">
            Pre/Post Comparison (±30 days)
        </h2>
        <table class="w-full text-sm">
            <thead class="border-b border-gray-200">
                <tr>
                    <th class="text-left py-2 text-xs font-semibold text-gray-500 uppercase tracking-wide">Metric</th>
                    <th class="text-right py-2 text-xs font-semibold text-gray-500 uppercase tracking-wide">Before</th>
                    <th class="text-right py-2 text-xs font-semibold text-gray-500 uppercase tracking-wide">After</th>
                    <th class="text-right py-2 text-xs font-semibold text-gray-500 uppercase tracking-wide">Delta</th>
                </tr>
            </thead>
            <tbody>
                {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}
            </tbody>
        </table>
    </div>
|]

renderMetricRow :: Text -> Int -> Int -> Bool -> Html
renderMetricRow label b a lowerIsBetter = [hsx|
    <tr class="border-b border-gray-50">
        <td class="py-2 text-gray-600">{label}</td>
        <td class="py-2 text-right text-gray-700">{showNA b}</td>
        <td class="py-2 text-right text-gray-700">{showNA a}</td>
        <td class="py-2 text-right">
            <span class={deltaClass (a - b) lowerIsBetter}>{showDelta (a - b)}</span>
        </td>
    </tr>
|]
  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|
    <tr>
        <td class="py-2 text-gray-600 font-medium">High/critical rate</td>
        <td class="py-2 text-right text-gray-700">{formatRate (highCriticalRate before)}</td>
        <td class="py-2 text-right text-gray-700">{formatRate (highCriticalRate after)}</td>
        <td class="py-2 text-right">
            <span class={rateClass (highCriticalRate after) (highCriticalRate before)}>
                {formatRateDelta (highCriticalRate after - highCriticalRate before)}
            </span>
        </td>
    </tr>
|]
  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 (replicate (fromIntegral n) '★') <> pack (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)