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}
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}
|]
renderNotes :: Text -> Html
renderNotes notes = [hsx|
|]
renderCandidateSection :: RequirementCandidate -> Html
renderCandidateSection c = [hsx|
|]
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}
|]
renderImplRef :: ImplementationChangeReference -> Html
renderImplRef ref = [hsx|
" text-xs px-2 py-0.5 rounded font-medium"}>
{ref.system}
{ref.workItemRef}
{show ref.linkedAt}
|]
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 (Prelude.replicate (fromIntegral n) 'โ
') <> pack (Prelude.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)