module Web.View.DecisionRecords.Show where import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude import Web.Routes () import Data.Int (Int16) data ShowView = ShowView { record :: !DecisionRecord , policyRefs :: ![PolicyReference] , implRefs :: ![ImplementationChangeReference] , deploymentRecords :: ![DeploymentRecord] , evaluations :: ![ChangeEvaluation] , mRequirement :: !(Maybe Requirement) , mCandidate :: !(Maybe RequirementCandidate) , users :: ![User] } instance View ShowView where html ShowView { .. } = [hsx|
Decisions / {record.title}

{record.title}

" text-xs px-2 py-0.5 rounded font-medium"}> {record.outcome} Edit
Decided by: {userName users record.decidedBy} ยท {show record.decidedAt}

Rationale

{record.rationale}

{maybe mempty renderNotes record.notes}

Linked Requirement

{renderLinkedRequirement mRequirement}
{maybe mempty renderCandidateSection mCandidate}

Policy References

{forEach policyRefs renderPolicyRef}
{hiddenField "authenticity_token"}

Deployments

{if null implRefs then mempty else renderNewDeploymentLink record.id}
{if null deploymentRecords then noDeploymentsMsg else forEach deploymentRecords (renderDeploymentRow evaluations)}

Implementation References

{forEach implRefs renderImplRef}
{hiddenField "authenticity_token"}
|] renderNotes :: Text -> Html renderNotes notes = [hsx|

Notes

{notes}

|] renderCandidateSection :: RequirementCandidate -> Html renderCandidateSection c = [hsx|

Source Candidate

{c.title}
|] renderPolicyRef :: PolicyReference -> Html renderPolicyRef ref = [hsx|
" text-xs px-2 py-0.5 rounded font-medium"}> {ref.policyScope} {maybe mempty renderConstraintNote ref.constraintNote} {show ref.createdAt}
{hiddenField "authenticity_token"}
|] renderImplRef :: ImplementationChangeReference -> Html renderImplRef ref = [hsx|
" text-xs px-2 py-0.5 rounded font-medium"}> {ref.system} {ref.workItemRef} {show ref.linkedAt}
{hiddenField "authenticity_token"}
|] 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" policyScopeClass :: Text -> Text policyScopeClass "regulatory" = "bg-red-50 text-red-700 border border-red-200" policyScopeClass "contractual" = "bg-orange-50 text-orange-700 border border-orange-200" policyScopeClass "external" = "bg-yellow-50 text-yellow-700 border border-yellow-200" policyScopeClass "architectural"= "bg-blue-50 text-blue-700 border border-blue-200" policyScopeClass _ = "bg-gray-50 text-gray-600 border border-gray-200" systemBadgeClass :: Text -> Text systemBadgeClass "github" = "bg-gray-800 text-white" systemBadgeClass "linear" = "bg-violet-100 text-violet-800" systemBadgeClass "jira" = "bg-blue-100 text-blue-800" systemBadgeClass _ = "bg-gray-100 text-gray-600" renderLinkedRequirement :: Maybe Requirement -> Html renderLinkedRequirement Nothing = [hsx|

No requirement linked.

|] renderLinkedRequirement (Just req) = [hsx| {req.title} |] renderNewDeploymentLink :: Id DecisionRecord -> Html renderNewDeploymentLink recordId = [hsx| "?decisionId=" <> show recordId} class="text-xs border border-indigo-300 text-indigo-600 px-3 py-1 rounded hover:bg-indigo-50"> New Deployment |] noDeploymentsMsg :: Html noDeploymentsMsg = [hsx|

No deployments recorded yet.

|] renderConstraintNote :: Text -> Html renderConstraintNote n = [hsx|{n}|] renderDeploymentRow :: [ChangeEvaluation] -> DeploymentRecord -> Html renderDeploymentRow evals dr = [hsx|
{dr.versionRef} {show dr.deployedAt}
{maybe mempty renderEvalSummary mEval}
|] where mEval = find (\e -> e.deploymentId == dr.id) evals renderEvalSummary :: ChangeEvaluation -> Html renderEvalSummary ev = [hsx| " text-xs px-2 py-0.5 rounded font-medium"}> {starsFor ev.score} |] starsFor :: Int16 -> Text starsFor n = pack (replicate (fromIntegral n) 'โ˜…') <> pack (replicate (5 - fromIntegral n) 'โ˜†') 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" userName :: [User] -> Maybe (Id User) -> Text userName _ Nothing = "โ€”" userName users (Just uid) = maybe "(unknown)" (.name) (find (\u -> u.id == uid) users)