coulomb/inter-hub
2
0
Fork 0
generated from coulomb/repo-seed
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

fix(WP-0014): pre-flight compilation fixes, Tailwind pipeline, and admin seed

Browse Source 
A2 — Compilation fixes:
- Remove inline FK constraints from Schema.sql; IHP schema compiler cannot
  parse them. Add 1744329600-restore-fk-constraints.sql migration to restore
  referential integrity at the DB level.
- Rename `#label` → `#label_` throughout to avoid clash with Haskell built-in.
- Fix `hub.id == hid` UUID comparisons to use `toUUID hub.id`.
- Replace non-existent `setStatus`/`respondJson` calls with
  `renderJsonWithStatusCode` throughout Api controllers.
- Fix qualified package import for `cryptohash-sha256` in Auth.hs.
- Add `CanSelect (Text, Text)` instance in Helper.View.
- Refactor HSX inline lambdas to named helper functions in 100+ views
  (GHC cannot infer types for anonymous functions inside quasi-quoted HSX).
- Fix missing imports (IHP.QueryBuilder, IHP.Fetch, Web.Routes, Only, etc.)
  across helpers and controllers.
- Remove duplicate `diffUTCTime` definition in BottleneckDetector.
- Change `createEventForHub` return type from `IO ResponseReceived` to `IO ()`.
- Seed type-registry vocabulary via 1744502400-seed-type-registries.sql
  (moved from Schema.sql where IHP does not execute INSERT statements).

A3 — Tailwind build pipeline:
- Add `tailwindcss` to flake.nix native packages.
- Uncomment `tailwind.exec` process in devenv shell config.
- Add tailwind/tailwind.config.js (scans Web/View/**/*.hs).
- Add tailwind/app.css with @tailwind directives.

A4 — Admin user seed:
- Add 1744416000-seed-admin-user.sql: inserts admin@inter-hub.local
  with bcrypt-hashed password admin1234! (cost 10).
- Add .env.example documenting all required environment variables
  and default admin credentials.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
Bernd Worsch
2026-04-04 09:55:12 +00:00
parent ffd5fbb900
commit f1978c3888
147 changed files with 2710 additions and 2075 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
Web/View/AdaptiveThresholds/Index.hs
View File

@@ -1,6 +1,6 @@
module Web.View.AdaptiveThresholds.Index where
import Web.View.Prelude
import IHP.ViewPrelude
import Data.Time (diffUTCTime)
data IndexView = IndexView
@@ -34,16 +34,9 @@ instance View IndexView where
<div class="flex justify-between items-start">
<div>
<h3 class="font-semibold text-gray-900">{h.name}</h3>
{case mCfg of
Nothing -> [hsx|<p class="text-sm text-gray-400 mt-1">Not calibrated</p>|]
Just cfg -> [hsx|
<p class="text-sm text-gray-600 mt-1">
Last calibrated: {show cfg.calibrationDate}
</p>
<p class="text-sm text-gray-500">{maybe "" id cfg.notes}</p>
|]}
{renderCfgStatus mCfg}
</div>
<form method="POST" action={CalibrateThresholdsAction { hubIdForThreshold = h.id }}>
<form method="POST" action={CalibrateThresholdsAction (h.id)}>
{csrfTokenTag}
<button type="submit"
class="px-3 py-1.5 text-sm bg-indigo-600 text-white rounded hover:bg-indigo-700">
@@ -60,3 +53,12 @@ instance View IndexView where
<p class="text-xs text-gray-400 mt-1">{show i.computedAt}</p>
</div>
|]
renderCfgStatus :: Maybe AdaptiveThresholdConfig -> Html
renderCfgStatus Nothing = [hsx|<p class="text-sm text-gray-400 mt-1">Not calibrated</p>|]
renderCfgStatus (Just cfg) = [hsx|
<p class="text-sm text-gray-600 mt-1">
Last calibrated: {show cfg.calibrationDate}
</p>
<p class="text-sm text-gray-500">{maybe "" id cfg.notes}</p>
|]

2
Web/View/AgentDelegations/Index.hs
View File

@@ -1,6 +1,6 @@
module Web.View.AgentDelegations.Index where
import Web.View.Prelude
import IHP.ViewPrelude
data IndexView = IndexView
{ delegations :: ![AgentDelegation] }

37
Web/View/AgentDelegations/Show.hs
View File

@@ -1,7 +1,8 @@
module Web.View.AgentDelegations.Show where
import Web.View.Prelude
import IHP.ViewPrelude
import Web.View.AgentDelegations.Index (statusBadge)
import Data.Aeson (Value)
data ShowView = ShowView
{ delegation :: !AgentDelegation
@@ -43,22 +44,24 @@ instance View ShowView where
</div>
</div>
{case mParentProposal of
Nothing -> mempty
Just p -> [hsx|
<div>
<p class="text-xs text-gray-500 mb-1">Parent Proposal</p>
<p class="text-sm font-mono text-gray-600">{p.proposalType} — {p.status}</p>
</div>
|]}
{maybe mempty renderParentProposal mParentProposal}
{case delegation.result of
Nothing -> mempty
Just r -> [hsx|
<div>
<h2 class="text-lg font-semibold text-gray-800 mb-2">Result</h2>
<pre class="bg-gray-100 rounded p-4 text-sm overflow-auto">{show r}</pre>
</div>
|]}
{maybe mempty renderDelegationResult delegation.result}
</div>
|]
renderParentProposal :: AgentProposal -> Html
renderParentProposal p = [hsx|
<div>
<p class="text-xs text-gray-500 mb-1">Parent Proposal</p>
<p class="text-sm font-mono text-gray-600">{p.proposalType} — {p.status}</p>
</div>
|]
renderDelegationResult :: Value -> Html
renderDelegationResult r = [hsx|
<div>
<h2 class="text-lg font-semibold text-gray-800 mb-2">Result</h2>
<pre class="bg-gray-100 rounded p-4 text-sm overflow-auto">{show r}</pre>
</div>
|]

36
Web/View/AgentProposals/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data IndexView = IndexView
{ proposals :: ![AgentProposal]
@@ -30,27 +31,34 @@ instance View IndexView where
<span class="text-gray-400 text-xs self-center mr-1">Type:</span>
<a href={agentProposalsUrl Nothing mStatusFilter}
class={typeTabClass Nothing mTypeFilter}>All</a>
{forEach allProposalTypes (\t -> [hsx|
<a href={agentProposalsUrl (Just t) mStatusFilter}
class={typeTabClass (Just t) mTypeFilter}>{t}</a>
|])}
{forEach allProposalTypes (renderTypeTab mStatusFilter mTypeFilter)}
</div>
<div class="flex gap-1 text-sm flex-wrap">
<span class="text-gray-400 text-xs self-center mr-1">Status:</span>
<a href={agentProposalsUrl mTypeFilter Nothing}
class={typeTabClass Nothing mStatusFilter}>All</a>
{forEach allStatuses (\s -> [hsx|
<a href={agentProposalsUrl mTypeFilter (Just s)}
class={typeTabClass (Just s) mStatusFilter}>{s}</a>
|])}
{forEach allStatuses (renderStatusTab mTypeFilter mStatusFilter)}
</div>
</div>
{if null proposals
then [hsx|<p class="text-sm text-gray-400">No proposals found.</p>|]
else renderTable proposals widgets}
{if null proposals then noProposalsMsg else renderTable proposals widgets}
|]
noProposalsMsg :: Html
noProposalsMsg = [hsx|<p class="text-sm text-gray-400">No proposals found.</p>|]
renderTypeTab :: Maybe Text -> Maybe Text -> Text -> Html
renderTypeTab mStatusFilter mTypeFilter t = [hsx|
<a href={agentProposalsUrl (Just t) mStatusFilter}
class={typeTabClass (Just t) mTypeFilter}>{t}</a>
|]
renderStatusTab :: Maybe Text -> Maybe Text -> Text -> Html
renderStatusTab mTypeFilter mStatusFilter s = [hsx|
<a href={agentProposalsUrl mTypeFilter (Just s)}
class={typeTabClass (Just s) mStatusFilter}>{s}</a>
|]
agentProposalsUrl :: Maybe Text -> Maybe Text -> Text
agentProposalsUrl mt ms =
let parts = catMaybes
@@ -83,7 +91,7 @@ renderRow :: [Widget] -> AgentProposal -> Html
renderRow widgets p = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3">
<a href={ShowAgentProposalAction { agentProposalId = p.id }}
<a href={ShowAgentProposalAction (p.id)}
class={proposalTypeBadge p.proposalType <> " text-xs px-2 py-0.5 rounded font-medium"}>
{p.proposalType}
</a>
@@ -99,9 +107,9 @@ renderRow widgets p = [hsx|
</tr>
|]
widgetName :: [Widget] -> Maybe (Id Widget) -> Text
widgetName :: [Widget] -> Maybe UUID -> Text
widgetName _ Nothing = "—"
widgetName widgets (Just wid) = maybe "(unknown)" (.name) (find (\w -> w.id == wid) widgets)
widgetName widgets (Just wid) = maybe "(unknown)" (.name) (find (\w -> toUUID w.id == wid) widgets)
renderConfidenceBar :: Maybe Double -> Html
renderConfidenceBar Nothing = [hsx|<span class="text-gray-300 text-xs">—</span>|]

25
Web/View/AgentProposals/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data ShowView = ShowView
{ proposal :: !AgentProposal
@@ -55,9 +56,7 @@ instance View ShowView where
</div>
<!-- Review section -->
{case mReview of
Just review -> renderExistingReview review users
Nothing -> renderReviewForm proposal.id proposal.status}
{renderReviewSection mReview users proposal.id proposal.status}
<!-- Attribution footer -->
<div class="text-xs text-gray-400 mt-4 border-t pt-3">
@@ -66,6 +65,12 @@ instance View ShowView where
</div>
|]
renderReviewSection :: Maybe AgentReviewRecord -> [User] -> Id AgentProposal -> Text -> Html
renderReviewSection mReview users proposalId status =
case mReview of
Just review -> renderExistingReview review users
Nothing -> renderReviewForm proposalId status
renderConfidences :: [ConfidenceAnnotation] -> Html
renderConfidences cs = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-5">
@@ -89,7 +94,7 @@ renderConfidenceRow c =
<div class="w-full bg-gray-100 rounded h-2">
<div class="bg-indigo-400 rounded h-2" style={barWidth}></div>
</div>
{maybe mempty (\e -> [hsx|<p class="text-xs text-gray-400 mt-0.5">{e}</p>|]) c.explanation}
{maybe mempty renderConfExplanation c.explanation}
</div>
|]
@@ -103,7 +108,7 @@ renderExistingReview review users = [hsx|
</span>
<span class="text-xs text-gray-400">by {reviewerName users review.reviewerId} at {show review.reviewedAt}</span>
</div>
{maybe mempty (\n -> [hsx|<p class="text-sm text-gray-600">{n}</p>|]) review.notes}
{maybe mempty renderReviewNote review.notes}
</div>
|]
@@ -119,7 +124,7 @@ renderReviewForm pid status
class="w-full border border-gray-300 rounded px-3 py-2 text-sm"></textarea>
</div>
<div class="flex gap-3">
<form method="POST" action={AcceptProposalAction { agentProposalId = pid }}
<form method="POST" action={AcceptProposalAction (pid)}
onsubmit="document.getElementById('accept-notes').value = document.getElementById('review-notes').value">
<input type="hidden" name="notes" id="accept-notes" />
<button type="submit"
@@ -127,7 +132,7 @@ renderReviewForm pid status
Accept
</button>
</form>
<form method="POST" action={RejectProposalAction { agentProposalId = pid }}
<form method="POST" action={RejectProposalAction (pid)}
onsubmit="document.getElementById('reject-notes').value = document.getElementById('review-notes').value">
<input type="hidden" name="notes" id="reject-notes" />
<button type="submit"
@@ -139,6 +144,12 @@ renderReviewForm pid status
</div>
|]
renderConfExplanation :: Text -> Html
renderConfExplanation e = [hsx|<p class="text-xs text-gray-400 mt-0.5">{e}</p>|]
renderReviewNote :: Text -> Html
renderReviewNote n = [hsx|<p class="text-sm text-gray-600">{n}</p>|]
reviewerName :: [User] -> Maybe (Id User) -> Text
reviewerName _ Nothing = "unknown"
reviewerName users (Just uid) = maybe "(unknown)" (.name) (find (\u -> u.id == uid) users)

2
Web/View/AgentRegistrations/Edit.hs
View File

@@ -1,6 +1,6 @@
module Web.View.AgentRegistrations.Edit where
import Web.View.Prelude
import IHP.ViewPrelude
import Web.View.AgentRegistrations.New (renderForm)
data EditView = EditView

2
Web/View/AgentRegistrations/Index.hs
View File

@@ -1,6 +1,6 @@
module Web.View.AgentRegistrations.Index where
import Web.View.Prelude
import IHP.ViewPrelude
data IndexView = IndexView
{ agents :: ![AgentRegistration]

14
Web/View/AgentRegistrations/New.hs
View File

@@ -1,6 +1,6 @@
module Web.View.AgentRegistrations.New where
import Web.View.Prelude
import IHP.ViewPrelude
data NewView = NewView
{ agent :: !AgentRegistration
@@ -19,13 +19,13 @@ renderForm :: AgentRegistration -> [Hub] -> Html
renderForm agent hubs = formFor agent [hsx|
<div class="space-y-4">
<div>
{(textField #hubId) { label = "Hub", fieldClass = "block w-full border-gray-300 rounded-md shadow-sm" }}
{(textField #hubId) { fieldLabel = "Hub", fieldClass = "block w-full border-gray-300 rounded-md shadow-sm" }}
</div>
<div class="grid grid-cols-2 gap-4">
<div>{(textField #name) { label = "Name" }}</div>
<div>{(textField #slug) { label = "Slug (unique identifier)" }}</div>
<div>{(textField #name) { fieldLabel = "Name" }}</div>
<div>{(textField #slug) { fieldLabel = "Slug (unique identifier)" }}</div>
</div>
<div>{(textareaField #description) { label = "Description" }}</div>
<div>{(textareaField #description) { fieldLabel = "Description" }}</div>
<div class="grid grid-cols-2 gap-4">
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Provider</label>
@@ -36,7 +36,7 @@ renderForm agent hubs = formFor agent [hsx|
<option value="claude-code">claude-code</option>
</select>
</div>
<div>{(textField #modelName) { label = "Model Name" }}</div>
<div>{(textField #modelName) { fieldLabel = "Model Name" }}</div>
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Trust Level</label>
@@ -46,7 +46,7 @@ renderForm agent hubs = formFor agent [hsx|
<option value="autonomous">autonomous</option>
</select>
</div>
<div>{(textareaField #systemPrompt) { label = "System Prompt (optional)" }}</div>
<div>{(textareaField #systemPrompt) { fieldLabel = "System Prompt (optional)" }}</div>
<div class="flex gap-3 pt-2">
{submitButton { label = "Register Agent" }}
<a href={AgentRegistrationsAction}

2
Web/View/AgentRegistrations/Performance.hs
View File

@@ -3,5 +3,5 @@ module Web.View.AgentRegistrations.Performance where
-- Performance view is rendered inline in Show.hs via performancePanel helper.
-- This module re-exports it for use if needed as a standalone view.
import Web.View.Prelude
import IHP.ViewPrelude
import Web.View.AgentRegistrations.Show (performancePanel)

66
Web/View/AgentRegistrations/Show.hs
View File

@@ -1,7 +1,8 @@
module Web.View.AgentRegistrations.Show where
import Web.View.Prelude
import IHP.ViewPrelude
import Web.View.AgentRegistrations.Index (trustBadge, statusBadge)
import Text.Printf (printf)
data ShowView = ShowView
{ agent :: !AgentRegistration
@@ -51,16 +52,12 @@ instance View ShowView where
<div>
<h2 class="text-lg font-semibold text-gray-800 mb-3">Routing Policies</h2>
{if null policies
then [hsx|<p class="text-sm text-gray-500">No routing policies. <a href={NewModelRoutingPolicyAction} class="text-blue-600">Add one</a>.</p>|]
else policiesTable}
{if null policies then noPoliciesMsg else policiesTable}
</div>
<div>
<h2 class="text-lg font-semibold text-gray-800 mb-3">Recent Proposals (last 10)</h2>
{if null recentProposals
then [hsx|<p class="text-sm text-gray-500">No proposals yet.</p>|]
else proposalsTable}
{if null recentProposals then noProposalsMsg else proposalsTable}
</div>
</div>
|]
@@ -76,13 +73,7 @@ instance View ShowView where
</tr>
</thead>
<tbody class="divide-y divide-gray-200">
{forEach policies \p -> [hsx|
<tr>
<td class="px-4 py-3 text-sm font-mono">{p.taskType}</td>
<td class="px-4 py-3 text-sm">{show p.priority}</td>
<td class="px-4 py-3">{statusBadge p.isActive}</td>
</tr>
|]}
{forEach policies renderPolicyRow}
</tbody>
</table>
</div>
@@ -100,21 +91,43 @@ instance View ShowView where
</tr>
</thead>
<tbody class="divide-y divide-gray-200">
{forEach recentProposals \p -> [hsx|
<tr>
<td class="px-4 py-3 text-sm font-mono">{p.proposalType}</td>
<td class="px-4 py-3 text-sm">{p.status}</td>
<td class="px-4 py-3 text-sm text-gray-500">
{maybe "—" show p.tokensIn} / {maybe "—" show p.tokensOut}
</td>
<td class="px-4 py-3 text-sm text-gray-500">{timeAgo p.createdAt}</td>
</tr>
|]}
{forEach recentProposals renderProposalRow}
</tbody>
</table>
</div>
|]
renderMeanConfidence :: Maybe Double -> Html
renderMeanConfidence Nothing = [hsx|<p class="mt-3 text-sm text-gray-400">Mean confidence: —</p>|]
renderMeanConfidence (Just c) = [hsx|<p class="mt-3 text-sm text-gray-600">Mean confidence: {printf "%.2f" c :: String}</p>|]
renderPolicyRow :: ModelRoutingPolicy -> Html
renderPolicyRow p = [hsx|
<tr>
<td class="px-4 py-3 text-sm font-mono">{p.taskType}</td>
<td class="px-4 py-3 text-sm">{show p.priority}</td>
<td class="px-4 py-3">{statusBadge p.isActive}</td>
</tr>
|]
noPoliciesMsg :: Html
noPoliciesMsg = [hsx|<p class="text-sm text-gray-500">No routing policies. <a href={NewModelRoutingPolicyAction} class="text-blue-600">Add one</a>.</p>|]
noProposalsMsg :: Html
noProposalsMsg = [hsx|<p class="text-sm text-gray-500">No proposals yet.</p>|]
renderProposalRow :: AgentProposal -> Html
renderProposalRow p = [hsx|
<tr>
<td class="px-4 py-3 text-sm font-mono">{p.proposalType}</td>
<td class="px-4 py-3 text-sm">{p.status}</td>
<td class="px-4 py-3 text-sm text-gray-500">
{maybe "—" show p.tokensIn} / {maybe "—" show p.tokensOut}
</td>
<td class="px-4 py-3 text-sm text-gray-500">{timeAgo p.createdAt}</td>
</tr>
|]
performancePanel :: Maybe AgentPerformanceRecord -> Html
performancePanel Nothing = [hsx|
<div class="bg-yellow-50 border border-yellow-200 rounded-lg p-4 text-sm text-yellow-800">
@@ -145,9 +158,6 @@ performancePanel (Just p) =
<p class="text-xs text-gray-500">Acceptance rate</p>
</div>
</div>
{case p.meanConfidence of
Nothing -> [hsx|<p class="mt-3 text-sm text-gray-400">Mean confidence: —</p>|]
Just c -> [hsx|<p class="mt-3 text-sm text-gray-600">Mean confidence: {printf "%.2f" c :: String}</p>|]
}
{renderMeanConfidence p.meanConfidence}
</div>
|]

10
Web/View/AiGovernancePolicies/Index.hs
View File

@@ -1,6 +1,6 @@
module Web.View.AiGovernancePolicies.Index where
import Web.View.Prelude
import IHP.ViewPrelude
data IndexView = IndexView
{ policies :: ![AiGovernancePolicy]
@@ -48,9 +48,7 @@ instance View IndexView where
<td class="px-6 py-4 text-sm font-mono">{p.artifactType}</td>
<td class="px-6 py-4 text-sm text-gray-600">{show p.allowedActions}</td>
<td class="px-6 py-4">
{if p.isActive
then [hsx|<span class="text-green-600 text-sm">Active</span>|]
else [hsx|<span class="text-gray-400 text-sm">Inactive</span>|]}
{renderActiveStatus p.isActive}
</td>
<td class="px-6 py-4 text-right">
<a href={ToggleAiGovernancePolicyAction p.id}
@@ -61,3 +59,7 @@ instance View IndexView where
</td>
</tr>
|]
renderActiveStatus :: Bool -> Html
renderActiveStatus True = [hsx|<span class="text-green-600 text-sm">Active</span>|]
renderActiveStatus False = [hsx|<span class="text-gray-400 text-sm">Inactive</span>|]

29
Web/View/AiGovernancePolicies/New.hs
View File

@@ -1,6 +1,6 @@
module Web.View.AiGovernancePolicies.New where
import Web.View.Prelude
import IHP.ViewPrelude
data NewView = NewView
{ policy :: !AiGovernancePolicy
@@ -8,6 +8,20 @@ data NewView = NewView
, agents :: ![AgentRegistration]
}
renderHubOption :: Hub -> Html
renderHubOption h = [hsx|<option value={show h.id}>{h.name}</option>|]
renderAgentOption :: AgentRegistration -> Html
renderAgentOption a = [hsx|<option value={show a.id}>{a.name}</option>|]
renderActionOption :: (Text, Text) -> Html
renderActionOption (val, lbl) = [hsx|
<label class="flex items-center gap-2 text-sm">
<input type="checkbox" name="allowedActions" value={val} class="rounded" />
<span>{lbl}</span>
</label>
|]
allowedActionOptions :: [(Text, Text)]
allowedActionOptions =
[ ("read", "read — agent may read artifacts")
@@ -25,25 +39,20 @@ instance View NewView where
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Hub</label>
<select name="hubId" class="block w-full border-gray-300 rounded-md shadow-sm text-sm">
{forEach hubs \h -> [hsx|<option value={show h.id}>{h.name}</option>|]}
{forEach hubs renderHubOption}
</select>
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Agent</label>
<select name="agentRegistrationId" class="block w-full border-gray-300 rounded-md shadow-sm text-sm">
{forEach agents \a -> [hsx|<option value={show a.id}>{a.name}</option>|]}
{forEach agents renderAgentOption}
</select>
</div>
<div>{(textField #artifactType) { label = "Artifact Type", placeholder = "e.g. requirement_candidate, annotation, decision_record" }}</div>
<div>{(textField #artifactType) { fieldLabel = "Artifact Type", placeholder = "e.g. requirement_candidate, annotation, decision_record" }}</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-2">Allowed Actions</label>
<div class="space-y-2">
{forEach allowedActionOptions \(val, label) -> [hsx|
<label class="flex items-center gap-2 text-sm">
<input type="checkbox" name="allowedActions" value={val} class="rounded" />
<span>{label}</span>
</label>
|]}
{forEach allowedActionOptions renderActionOption}
</div>
</div>
<div class="flex gap-3 pt-2">

28
Web/View/AnnotationThreads/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data IndexView = IndexView
{ widget :: !Widget
@@ -16,28 +17,30 @@ instance View IndexView where
<div class="mb-6 flex items-center gap-2 text-sm text-gray-500">
<a href={WidgetsAction} class="hover:text-gray-700">Widgets</a>
<span>/</span>
<a href={ShowWidgetAction { widgetId = widget.id }} class="hover:text-gray-700">{widget.name}</a>
<a href={ShowWidgetAction (widget.id)} class="hover:text-gray-700">{widget.name}</a>
<span>/</span>
<span>Threads</span>
</div>
<div class="flex items-center justify-between mb-4">
<h1 class="text-2xl font-semibold">Annotation Threads</h1>
<a href={NewAnnotationThreadAction { widgetId = widget.id }}
<a href={NewAnnotationThreadAction (widget.id)}
class="bg-indigo-600 text-white text-sm font-medium px-4 py-2 rounded hover:bg-indigo-700">
New Thread
</a>
</div>
{if null threads
then [hsx|<p class="text-sm text-gray-500">No threads yet.</p>|]
else [hsx|
<div class="space-y-3">
{forEach threads (renderThreadRow allAnnotations)}
</div>
|]}
{renderThreadsSection threads allAnnotations}
|]
renderThreadsSection :: [AnnotationThread] -> [Annotation] -> Html
renderThreadsSection [] _ = [hsx|<p class="text-sm text-gray-500">No threads yet.</p>|]
renderThreadsSection threads allAnnotations = [hsx|
<div class="space-y-3">
{forEach threads (renderThreadRow allAnnotations)}
</div>
|]
renderThreadRow :: [Annotation] -> AnnotationThread -> Html
renderThreadRow allAnnotations t =
let members = filter (\a -> a.threadId == Just t.id) allAnnotations
@@ -47,11 +50,11 @@ renderThreadRow allAnnotations t =
<div class="bg-white rounded-lg border border-gray-200 px-5 py-4">
<div class="flex items-start justify-between">
<div>
<a href={ShowAnnotationThreadAction { annotationThreadId = t.id }}
<a href={ShowAnnotationThreadAction (t.id)}
class="font-medium text-indigo-600 hover:text-indigo-800">
{t.title}
</a>
{maybe mempty (\d -> [hsx|<p class="text-sm text-gray-500 mt-1">{d}</p>|]) t.description}
{maybe mempty renderThreadDesc t.description}
</div>
<span class="text-xs text-gray-400 ml-4 whitespace-nowrap">{show t.createdAt}</span>
</div>
@@ -62,6 +65,9 @@ renderThreadRow allAnnotations t =
</div>
|]
renderThreadDesc :: Text -> Html
renderThreadDesc d = [hsx|<p class="text-sm text-gray-500 mt-1">{d}</p>|]
buildSeverityBreakdown :: [Annotation] -> [(Text, Int)]
buildSeverityBreakdown annotations =
[ ("low", length $ filter (\a -> a.severity == "low") annotations)

5
Web/View/AnnotationThreads/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView
{ widget :: !Widget
@@ -13,9 +14,9 @@ data NewView = NewView
instance View NewView where
html NewView { .. } = [hsx|
<div class="mb-6 flex items-center gap-2 text-sm text-gray-500">
<a href={ShowWidgetAction { widgetId = widget.id }} class="hover:text-gray-700">{widget.name}</a>
<a href={ShowWidgetAction (widget.id)} class="hover:text-gray-700">{widget.name}</a>
<span>/</span>
<a href={WidgetAnnotationThreadsAction { widgetId = widget.id }} class="hover:text-gray-700">Threads</a>
<a href={WidgetAnnotationThreadsAction (widget.id)} class="hover:text-gray-700">Threads</a>
<span>/</span>
<span>New</span>
</div>

26
Web/View/AnnotationThreads/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data ShowView = ShowView
{ widget :: !Widget
@@ -14,9 +15,9 @@ data ShowView = ShowView
instance View ShowView where
html ShowView { .. } = [hsx|
<div class="mb-6 flex items-center gap-2 text-sm text-gray-500">
<a href={ShowWidgetAction { widgetId = widget.id }} class="hover:text-gray-700">{widget.name}</a>
<a href={ShowWidgetAction (widget.id)} class="hover:text-gray-700">{widget.name}</a>
<span>/</span>
<a href={WidgetAnnotationThreadsAction { widgetId = widget.id }} class="hover:text-gray-700">Threads</a>
<a href={WidgetAnnotationThreadsAction (widget.id)} class="hover:text-gray-700">Threads</a>
<span>/</span>
<span>{thread.title}</span>
</div>
@@ -24,7 +25,7 @@ instance View ShowView where
<div class="max-w-2xl">
<div class="mb-6">
<h1 class="text-2xl font-semibold">{thread.title}</h1>
{maybe mempty (\d -> [hsx|<p class="text-sm text-gray-500 mt-1">{d}</p>|]) thread.description}
{maybe mempty renderThreadDesc thread.description}
</div>
<div class="mb-4 flex items-center gap-3">
@@ -59,11 +60,17 @@ renderSeverityBar annotations =
nonZero = filter (\(_, n) -> n > 0) counts
in if total == 0
then mempty
else [hsx|
<div class="flex items-center gap-1">
{forEach nonZero (\(s, n) -> renderBarSegment s n total)}
</div>
|]
else renderSeverityBarItems nonZero total
renderSeverityBarItems :: [(Text, Int)] -> Int -> Html
renderSeverityBarItems nonZero total = [hsx|
<div class="flex items-center gap-1">
{forEach nonZero (renderBarSegmentPair total)}
</div>
|]
renderBarSegmentPair :: Int -> (Text, Int) -> Html
renderBarSegmentPair total (s, n) = renderBarSegment s n total
renderBarSegment :: Text -> Int -> Int -> Html
renderBarSegment sev n total =
@@ -73,6 +80,9 @@ renderBarSegment sev n total =
</div>
|]
renderThreadDesc :: Text -> Html
renderThreadDesc d = [hsx|<p class="text-sm text-gray-500 mt-1">{d}</p>|]
barColor :: Text -> Text
barColor "low" = "bg-gray-300"
barColor "medium" = "bg-blue-400"

24
Web/View/Annotations/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data IndexView = IndexView
{ widget :: !Widget
@@ -11,18 +12,21 @@ data IndexView = IndexView
}
instance View IndexView where
html IndexView { .. } = [hsx|
html IndexView { .. } =
let rootAnnotations = filter (\a -> isNothing a.parentId) annotations
childrenOf parent = filter (\a -> a.parentId == Just parent.id) annotations
in [hsx|
<div class="mb-6 flex items-center gap-2 text-sm text-gray-500">
<a href={WidgetsAction} class="hover:text-gray-700">Widgets</a>
<span>/</span>
<a href={ShowWidgetAction { widgetId = widget.id }} class="hover:text-gray-700">{widget.name}</a>
<a href={ShowWidgetAction (widget.id)} class="hover:text-gray-700">{widget.name}</a>
<span>/</span>
<span>Annotations</span>
</div>
<div class="flex items-center justify-between mb-4">
<h1 class="text-2xl font-semibold">Annotations for {widget.name}</h1>
<a href={NewAnnotationAction { widgetId = widget.id }}
<a href={NewAnnotationAction (widget.id)}
class="bg-indigo-600 text-white text-sm font-medium px-4 py-2 rounded hover:bg-indigo-700">
Add Annotation
</a>
@@ -32,9 +36,6 @@ instance View IndexView where
{forEach rootAnnotations (renderAnnotation childrenOf)}
</div>
|]
where
rootAnnotations = filter (\a -> isNothing a.parentId) annotations
childrenOf parent = filter (\a -> a.parentId == Just parent.id) annotations
renderAnnotation :: (Annotation -> [Annotation]) -> Annotation -> Html
renderAnnotation childrenOf a = [hsx|
@@ -47,16 +48,14 @@ renderAnnotation childrenOf a = [hsx|
{a.severity}
</span>
<span class="text-xs text-gray-400">{a.actorType}</span>
{if isJust a.retractedAt
then [hsx|<span class="text-xs text-red-400 italic">retracted</span>|]
else mempty}
{if isJust a.retractedAt then retractedBadge else mempty}
<span class="ml-auto text-xs text-gray-300">{show a.createdAt}</span>
</div>
<p class="text-sm text-gray-700">{a.body}</p>
<div class="mt-2 flex gap-2">
<a href={NewAnnotationAction { widgetId = a.widgetId }}
<a href={NewAnnotationAction (a.widgetId)}
class="text-xs text-indigo-500 hover:text-indigo-700">Reply</a>
<a href={ShowAnnotationAction { annotationId = a.id }}
<a href={ShowAnnotationAction (a.id)}
class="text-xs text-gray-400 hover:text-gray-600">Details / Escalate</a>
</div>
<div class="ml-6 mt-3 space-y-3">
@@ -65,6 +64,9 @@ renderAnnotation childrenOf a = [hsx|
</div>
|]
retractedBadge :: Html
retractedBadge = [hsx|<span class="text-xs text-red-400 italic">retracted</span>|]
severityClass :: Text -> Text
severityClass "low" = "text-xs px-2 py-0.5 rounded bg-gray-100 text-gray-500"
severityClass "medium" = "text-xs px-2 py-0.5 rounded bg-blue-100 text-blue-700"

7
Web/View/Annotations/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView
{ widget :: !Widget
@@ -15,9 +16,9 @@ instance View NewView where
html NewView { .. } = [hsx|
<div class="max-w-lg">
<div class="flex items-center gap-2 text-sm text-gray-500 mb-4">
<a href={ShowWidgetAction { widgetId = widget.id }} class="hover:text-gray-700">{widget.name}</a>
<a href={ShowWidgetAction (widget.id)} class="hover:text-gray-700">{widget.name}</a>
<span>/</span>
<a href={WidgetAnnotationsAction { widgetId = widget.id }} class="hover:text-gray-700">Annotations</a>
<a href={WidgetAnnotationsAction (widget.id)} class="hover:text-gray-700">Annotations</a>
<span>/</span>
<span>New</span>
</div>
@@ -35,7 +36,7 @@ renderForm annotation widgetId categories = formFor annotation [hsx|
|]
categoryOptions :: [AnnotationCategoryRegistry] -> [(Text, Text)]
categoryOptions = map (\r -> (r.label, r.name))
categoryOptions = map (\r -> (r.label_, r.name))
severityOptions :: [(Text, Text)]
severityOptions =

17
Web/View/Annotations/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data ShowView = ShowView
{ widget :: !Widget
@@ -16,9 +17,9 @@ instance View ShowView where
<div class="mb-6 flex items-center gap-2 text-sm text-gray-500">
<a href={WidgetsAction} class="hover:text-gray-700">Widgets</a>
<span>/</span>
<a href={ShowWidgetAction { widgetId = widget.id }} class="hover:text-gray-700">{widget.name}</a>
<a href={ShowWidgetAction (widget.id)} class="hover:text-gray-700">{widget.name}</a>
<span>/</span>
<a href={WidgetAnnotationsAction { widgetId = widget.id }} class="hover:text-gray-700">Annotations</a>
<a href={WidgetAnnotationsAction (widget.id)} class="hover:text-gray-700">Annotations</a>
<span>/</span>
<span>Detail</span>
</div>
@@ -32,9 +33,7 @@ instance View ShowView where
<span class={severityClass annotation.severity}>
{annotation.severity}
</span>
{if isJust annotation.retractedAt
then [hsx|<span class="text-xs text-red-400 italic">retracted</span>|]
else mempty}
{if isJust annotation.retractedAt then retractedBadge else mempty}
<span class="ml-auto text-xs text-gray-400">{show annotation.createdAt}</span>
</div>
<p class="text-sm text-gray-800 leading-relaxed">{annotation.body}</p>
@@ -50,8 +49,7 @@ instance View ShowView where
renderEscalation :: Annotation -> Maybe RequirementCandidate -> Html
renderEscalation annotation Nothing = [hsx|
<p class="text-sm text-gray-500 mb-3">This annotation has not been escalated yet.</p>
<form method="POST" action={EscalateAnnotationAction { annotationId = annotation.id }}>
{hiddenField "authenticity_token"}
<form method="POST" action={EscalateAnnotationAction (annotation.id)}>
<button type="submit"
class="text-sm bg-amber-600 text-white px-4 py-2 rounded hover:bg-amber-700">
Escalate to Requirement Candidate
@@ -60,7 +58,7 @@ renderEscalation annotation Nothing = [hsx|
|]
renderEscalation _ (Just candidate) = [hsx|
<p class="text-sm text-gray-600 mb-2">Escalated to:</p>
<a href={ShowRequirementCandidateAction { requirementCandidateId = candidate.id }}
<a href={ShowRequirementCandidateAction (candidate.id)}
class="text-sm text-indigo-600 hover:text-indigo-800 font-medium">
{candidate.title} →
</a>
@@ -69,6 +67,9 @@ renderEscalation _ (Just candidate) = [hsx|
</span>
|]
retractedBadge :: Html
retractedBadge = [hsx|<span class="text-xs text-red-400 italic">retracted</span>|]
severityClass :: Text -> Text
severityClass "low" = "text-xs px-2 py-0.5 rounded bg-gray-100 text-gray-500"
severityClass "medium" = "text-xs px-2 py-0.5 rounded bg-blue-100 text-blue-700"

18
Web/View/ApiConsumers/Edit.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data EditView = EditView
{ consumer :: !ApiConsumer
@@ -15,31 +16,31 @@ instance View EditView where
<div class="max-w-lg">
<h1 class="text-2xl font-semibold mb-6">Edit API Consumer</h1>
<form method="POST" action={UpdateApiConsumerAction consumer.id} class="space-y-4">
{hiddenField #id}
<input type="hidden" name="id" value={show consumer.id} />
<input type="hidden" name="_method" value="PATCH"/>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name *</label>
{textField #name}
<input type="text" name="name" value={consumer.name} class="border rounded px-3 py-2 text-sm w-full" />
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Description</label>
{textareaField #description}
<textarea name="description" class="border rounded px-3 py-2 text-sm w-full" rows="3">{maybe "" id consumer.description}</textarea>
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Linked Hub Manifest (optional)</label>
<select name="hubCapabilityManifestId" class="border rounded px-3 py-2 text-sm w-full">
<option value="">— none —</option>
{forEach manifests manifestOption}
{forEach manifests (manifestOption consumer.hubCapabilityManifestId)}
</select>
</div>
<div class="grid grid-cols-2 gap-4">
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Rate Limit (req/min)</label>
{numberField #rateLimitPerMinute}
<input type="number" name="rateLimitPerMinute" value={show consumer.rateLimitPerMinute} class="border rounded px-3 py-2 text-sm w-full" />
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Quota (req/day)</label>
{numberField #quotaPerDay}
<input type="number" name="quotaPerDay" value={show consumer.quotaPerDay} class="border rounded px-3 py-2 text-sm w-full" />
</div>
</div>
<div class="pt-2 flex gap-3">
@@ -52,9 +53,8 @@ instance View EditView where
</div>
|]
where
manifestOption m = [hsx|
<option value={show m.id}
{if consumer.hubCapabilityManifestId == Just m.id then "selected" else "" :: Text}>
manifestOption selectedId m = [hsx|
<option value={show m.id} selected={selectedId == Just (toUUID m.id)}>
Manifest {show m.id} ({m.status})
</option>
|]

9
Web/View/ApiConsumers/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data IndexView = IndexView { consumers :: ![ApiConsumer] }
@@ -57,9 +58,7 @@ instance View IndexView where
<td class="px-4 py-3 text-gray-600">{show consumer.rateLimitPerMinute}/min</td>
<td class="px-4 py-3 text-gray-600">{show consumer.quotaPerDay}</td>
<td class="px-4 py-3">
{if consumer.isActive
then [hsx|<span class="bg-green-100 text-green-700 text-xs px-2 py-0.5 rounded-full">active</span>|]
else [hsx|<span class="bg-gray-100 text-gray-500 text-xs px-2 py-0.5 rounded-full">inactive</span>|]}
{renderConsumerStatus consumer.isActive}
</td>
<td class="px-4 py-3 text-right">
<a href={EditApiConsumerAction consumer.id} class="text-gray-400 hover:text-gray-700 text-sm mr-3">Edit</a>
@@ -67,3 +66,7 @@ instance View IndexView where
</td>
</tr>
|]
renderConsumerStatus :: Bool -> Html
renderConsumerStatus True = [hsx|<span class="bg-green-100 text-green-700 text-xs px-2 py-0.5 rounded-full">active</span>|]
renderConsumerStatus False = [hsx|<span class="bg-gray-100 text-gray-500 text-xs px-2 py-0.5 rounded-full">inactive</span>|]

11
Web/View/ApiConsumers/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView
{ consumer :: !ApiConsumer
@@ -15,14 +16,14 @@ instance View NewView where
<div class="max-w-lg">
<h1 class="text-2xl font-semibold mb-6">New API Consumer</h1>
<form method="POST" action={CreateApiConsumerAction} class="space-y-4">
{hiddenField #id}
<input type="hidden" name="id" value={show consumer.id} />
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name *</label>
{textField #name}
<input type="text" name="name" value={consumer.name} class="border rounded px-3 py-2 text-sm w-full" />
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Description</label>
{textareaField #description}
<textarea name="description" class="border rounded px-3 py-2 text-sm w-full" rows="3">{maybe "" id consumer.description}</textarea>
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Linked Hub Manifest (optional)</label>
@@ -35,11 +36,11 @@ instance View NewView where
<div class="grid grid-cols-2 gap-4">
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Rate Limit (req/min)</label>
{numberField #rateLimitPerMinute}
<input type="number" name="rateLimitPerMinute" value={maybe "" show consumer.rateLimitPerMinute} class="border rounded px-3 py-2 text-sm w-full" />
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Quota (req/day)</label>
{numberField #quotaPerDay}
<input type="number" name="quotaPerDay" value={maybe "" show consumer.quotaPerDay} class="border rounded px-3 py-2 text-sm w-full" />
</div>
</div>
<div class="pt-2 flex gap-3">

52
Web/View/ApiConsumers/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data ShowView = ShowView
{ consumer :: !ApiConsumer
@@ -35,9 +36,7 @@ instance View ShowView where
<div class="grid grid-cols-3 gap-4 mb-8">
<div class="bg-white border rounded p-4">
<div class="text-xs text-gray-500 uppercase tracking-wide mb-1">Status</div>
{if consumer.isActive
then [hsx|<span class="bg-green-100 text-green-700 text-sm font-medium px-2 py-0.5 rounded">active</span>|]
else [hsx|<span class="bg-gray-100 text-gray-500 text-sm font-medium px-2 py-0.5 rounded">inactive</span>|]}
{renderConsumerStatusDetail consumer.isActive}
</div>
<div class="bg-white border rounded p-4">
<div class="text-xs text-gray-500 uppercase tracking-wide mb-1">Rate Limit</div>
@@ -59,9 +58,7 @@ instance View ShowView where
New Key
</a>
</div>
{if null apiKeys
then [hsx|<p class="text-sm text-gray-400">No keys yet.</p>|]
else keysTable}
{if null apiKeys then noKeysMsg else keysTable}
</div>
<div>
@@ -72,9 +69,7 @@ instance View ShowView where
New Subscription
</a>
</div>
{if null webhooks
then [hsx|<p class="text-sm text-gray-400">No webhooks yet.</p>|]
else webhooksTable}
{if null webhooks then noWebhooksMsg else webhooksTable}
</div>
|]
where
@@ -113,16 +108,10 @@ instance View ShowView where
<td class="px-4 py-2 text-gray-500">{if k.scopes == "" then "–" else k.scopes}</td>
<td class="px-4 py-2 text-gray-500">{maybe "never" show k.expiresAt}</td>
<td class="px-4 py-2">
{if isJust k.revokedAt
then [hsx|<span class="text-red-500 text-xs">revoked</span>|]
else [hsx|<span class="text-green-600 text-xs">active</span>|]}
{renderKeyStatus (isJust k.revokedAt)}
</td>
<td class="px-4 py-2 text-right">
{if isNothing k.revokedAt
then [hsx|<a href={RevokeApiKeyAction k.id} data-method="post"
data-confirm="Revoke this key? This cannot be undone."
class="text-red-500 hover:text-red-700 text-xs">Revoke</a>|]
else mempty}
{renderRevokeLink k}
</td>
</tr>
|]
@@ -146,9 +135,7 @@ instance View ShowView where
<td class="px-4 py-2 font-mono text-xs">{wh.eventType}</td>
<td class="px-4 py-2 text-gray-500 text-xs truncate max-w-xs">{wh.targetUrl}</td>
<td class="px-4 py-2">
{if wh.isActive
then [hsx|<span class="text-green-600 text-xs">active</span>|]
else [hsx|<span class="text-gray-400 text-xs">paused</span>|]}
{renderWebhookStatus wh.isActive}
</td>
<td class="px-4 py-2 text-right">
<a href={ToggleWebhookSubscriptionAction wh.id} data-method="post"
@@ -159,3 +146,28 @@ instance View ShowView where
</td>
</tr>
|]
noKeysMsg :: Html
noKeysMsg = [hsx|<p class="text-sm text-gray-400">No keys yet.</p>|]
noWebhooksMsg :: Html
noWebhooksMsg = [hsx|<p class="text-sm text-gray-400">No webhooks yet.</p>|]
renderWebhookStatus :: Bool -> Html
renderWebhookStatus True = [hsx|<span class="text-green-600 text-xs">active</span>|]
renderWebhookStatus False = [hsx|<span class="text-gray-400 text-xs">paused</span>|]
renderConsumerStatusDetail :: Bool -> Html
renderConsumerStatusDetail True = [hsx|<span class="bg-green-100 text-green-700 text-sm font-medium px-2 py-0.5 rounded">active</span>|]
renderConsumerStatusDetail False = [hsx|<span class="bg-gray-100 text-gray-500 text-sm font-medium px-2 py-0.5 rounded">inactive</span>|]
renderKeyStatus :: Bool -> Html
renderKeyStatus True = [hsx|<span class="text-red-500 text-xs">revoked</span>|]
renderKeyStatus False = [hsx|<span class="text-green-600 text-xs">active</span>|]
renderRevokeLink :: ApiKey -> Html
renderRevokeLink k
| isNothing k.revokedAt = [hsx|<a href={RevokeApiKeyAction k.id} data-method="post"
data-confirm="Revoke this key? This cannot be undone."
class="text-red-500 hover:text-red-700 text-xs">Revoke</a>|]
| otherwise = mempty

6
Web/View/ApiDashboard/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Maybe (fromMaybe)
data ConsumerStats = ConsumerStats
@@ -24,11 +25,10 @@ instance View ShowView where
</div>
<a href={ApiConsumersAction} class="text-sm text-gray-500 hover:text-gray-700">← Consumers</a>
</div>
{if null stats
then [hsx|<p class="text-sm text-gray-400">No API activity yet.</p>|]
else statsTable}
{if null stats then noStatsMsg else statsTable}
|]
where
noStatsMsg = [hsx|<p class="text-sm text-gray-400">No API activity yet.</p>|]
statsTable = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">

1
Web/View/ApiKeys/Created.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data CreatedView = CreatedView
{ consumer :: !ApiConsumer

5
Web/View/ApiKeys/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView
{ apiKey :: !ApiKey
@@ -16,11 +17,11 @@ instance View NewView where
<h1 class="text-2xl font-semibold mb-2">New API Key</h1>
<p class="text-sm text-gray-500 mb-6">For consumer: <strong>{consumer.name}</strong></p>
<form method="POST" action={CreateApiKeyAction} class="space-y-4">
{hiddenField #id}
<input type="hidden" name="id" value={show apiKey.id} />
<input type="hidden" name="apiConsumerId" value={show consumer.id} />
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Scopes (space-separated)</label>
{textField #scopes}
<input type="text" name="scopes" value={apiKey.scopes} class="border rounded px-3 py-2 text-sm w-full" />
<p class="text-xs text-gray-400 mt-1">e.g. framework:read hub:dev-hub:read hub:dev-hub:write</p>
</div>
<div class="pt-2 flex gap-3">

83
Web/View/ArchiveRecords/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data IndexView = IndexView
{ records :: ![ArchiveRecord]
@@ -15,44 +16,46 @@ instance View IndexView where
<h1 class="text-2xl font-semibold">Archive Records</h1>
</div>
{if null records
then [hsx|<p class="text-sm text-gray-400">No archived artifacts yet.</p>|]
else [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Subject Type</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Subject ID</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Reason</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Archived By</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Archived At</th>
<th class="px-4 py-3"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach records renderRow}
</tbody>
</table>
</div>
|]}
{renderArchiveList records}
|]
where
renderRow :: ArchiveRecord -> Html
renderRow r = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3">
<span class="text-xs bg-amber-100 text-amber-700 px-2 py-0.5 rounded font-medium">
{r.subjectType}
</span>
</td>
<td class="px-4 py-3 font-mono text-xs text-gray-500">{show r.subjectId}</td>
<td class="px-4 py-3 text-gray-700">{r.reason}</td>
<td class="px-4 py-3 text-gray-500">{r.archivedBy}</td>
<td class="px-4 py-3 text-xs text-gray-400">{show r.archivedAt}</td>
<td class="px-4 py-3 text-right">
<a href={ShowArchiveRecordAction { archiveRecordId = r.id }}
class="text-xs text-blue-600 hover:underline">View</a>
</td>
</tr>
|]
renderArchiveList :: [ArchiveRecord] -> Html
renderArchiveList [] = [hsx|<p class="text-sm text-gray-400">No archived artifacts yet.</p>|]
renderArchiveList records = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Subject Type</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Subject ID</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Reason</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Archived By</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Archived At</th>
<th class="px-4 py-3"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach records renderArchiveRow}
</tbody>
</table>
</div>
|]
renderArchiveRow :: ArchiveRecord -> Html
renderArchiveRow r = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3">
<span class="text-xs bg-amber-100 text-amber-700 px-2 py-0.5 rounded font-medium">
{r.subjectType}
</span>
</td>
<td class="px-4 py-3 font-mono text-xs text-gray-500">{show r.subjectId}</td>
<td class="px-4 py-3 text-gray-700">{r.reason}</td>
<td class="px-4 py-3 text-gray-500">{r.archivedBy}</td>
<td class="px-4 py-3 text-xs text-gray-400">{show r.archivedAt}</td>
<td class="px-4 py-3 text-right">
<a href={ShowArchiveRecordAction (r.id)}
class="text-xs text-blue-600 hover:underline">View</a>
</td>
</tr>
|]

69
Web/View/ArchiveRecords/LineageInspector.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data LineageInspectorView = LineageInspectorView
{ widget :: !Widget
@@ -21,13 +22,11 @@ instance View LineageInspectorView where
html LineageInspectorView { .. } = [hsx|
<div class="max-w-4xl">
<div class="flex items-center gap-3 mb-2">
<a href={ShowWidgetAction { widgetId = widget.id }}
<a href={ShowWidgetAction (widget.id)}
class="text-sm text-gray-500 hover:underline">{widget.name}</a>
<span class="text-gray-300">/</span>
<h1 class="text-2xl font-semibold">Lineage Inspector</h1>
{if widget.isArchived
then [hsx|<span class="text-sm bg-amber-100 text-amber-700 px-2 py-0.5 rounded font-medium">Archived</span>|]
else mempty}
{if widget.isArchived then archivedBadge else mempty}
</div>
<p class="text-sm text-gray-500 mb-6">Full traceability chain for this widget.</p>
@@ -42,40 +41,33 @@ instance View LineageInspectorView where
{renderChainStep "8" "Outcome Signals" (length signals) Nothing}
</div>
{whenJust mArchive \archive -> [hsx|
<div class="mt-6 bg-amber-50 border border-amber-200 rounded-lg p-4">
<h3 class="text-sm font-medium text-amber-800 mb-2">Archive Record</h3>
<dl class="grid grid-cols-2 gap-2 text-xs text-amber-700">
<div><dt class="font-medium">Archived At</dt><dd>{show archive.archivedAt}</dd></div>
<div><dt class="font-medium">Archived By</dt><dd>{archive.archivedBy}</dd></div>
<div class="col-span-2"><dt class="font-medium">Reason</dt><dd>{archive.reason}</dd></div>
</dl>
</div>
|]}
{maybe mempty renderArchivePanel mArchive}
<div class="mt-8">
<h2 class="text-lg font-medium text-gray-800 mb-3">Recent Interaction Events</h2>
{if null events
then [hsx|<p class="text-sm text-gray-400">No events recorded.</p>|]
else [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-2 font-medium text-gray-600">Event Type</th>
<th class="text-left px-4 py-2 font-medium text-gray-600">Occurred At</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach events renderEventRow}
</tbody>
</table>
</div>
|]}
{renderEventsTable events}
</div>
</div>
|]
where
renderEventsTable :: [InteractionEvent] -> Html
renderEventsTable [] = [hsx|<p class="text-sm text-gray-400">No events recorded.</p>|]
renderEventsTable evs = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-2 font-medium text-gray-600">Event Type</th>
<th class="text-left px-4 py-2 font-medium text-gray-600">Occurred At</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach evs renderEventRow}
</tbody>
</table>
</div>
|]
renderChainStep :: Text -> Text -> Int -> Maybe a -> Html
renderChainStep stepNum label count mLink = [hsx|
<div class="flex items-center gap-4">
@@ -96,3 +88,18 @@ instance View LineageInspectorView where
<td class="px-4 py-2 text-xs text-gray-400">{show e.occurredAt}</td>
</tr>
|]
renderArchivePanel :: ArchiveRecord -> Html
renderArchivePanel archive = [hsx|
<div class="mt-6 bg-amber-50 border border-amber-200 rounded-lg p-4">
<h3 class="text-sm font-medium text-amber-800 mb-2">Archive Record</h3>
<dl class="grid grid-cols-2 gap-2 text-xs text-amber-700">
<div><dt class="font-medium">Archived At</dt><dd>{show archive.archivedAt}</dd></div>
<div><dt class="font-medium">Archived By</dt><dd>{archive.archivedBy}</dd></div>
<div class="col-span-2"><dt class="font-medium">Reason</dt><dd>{archive.reason}</dd></div>
</dl>
</div>
|]
archivedBadge :: Html
archivedBadge = [hsx|<span class="text-sm bg-amber-100 text-amber-700 px-2 py-0.5 rounded font-medium">Archived</span>|]

35
Web/View/ArchiveRecords/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data ShowView = ShowView
{ record :: !ArchiveRecord
@@ -40,22 +41,28 @@ instance View ShowView where
<dt class="text-gray-500">Reason</dt>
<dd class="text-gray-700">{record.reason}</dd>
</div>
{whenJust record.lineageRef \ref -> [hsx|
<div class="col-span-2">
<dt class="text-gray-500">Lineage Reference</dt>
<dd class="font-mono text-xs text-gray-700">{ref}</dd>
</div>
|]}
{maybe mempty renderLineageRefDt record.lineageRef}
</dl>
</div>
{if record.subjectType == "Widget"
then [hsx|
<div class="mt-4">
<a href={LineageInspectorAction { widgetId = coerce record.subjectId }}
class="text-sm text-indigo-600 hover:underline">View Lineage →</a>
</div>
|]
else mempty}
{renderLineageLink record}
</div>
|]
renderLineageRefDt :: Text -> Html
renderLineageRefDt ref = [hsx|
<div class="col-span-2">
<dt class="text-gray-500">Lineage Reference</dt>
<dd class="font-mono text-xs text-gray-700">{ref}</dd>
</div>
|]
renderLineageLink :: ArchiveRecord -> Html
renderLineageLink record
| record.subjectType == "Widget" = [hsx|
<div class="mt-4">
<a href={LineageInspectorAction (coerce record.subjectId)}
class="text-sm text-indigo-600 hover:underline">View Lineage →</a>
</div>
|]
| otherwise = mempty

2
Web/View/CollectiveProposals/Index.hs
View File

@@ -1,6 +1,6 @@
module Web.View.CollectiveProposals.Index where
import Web.View.Prelude
import IHP.ViewPrelude
data IndexView = IndexView
{ proposals :: ![CollectiveProposal] }

54
Web/View/CollectiveProposals/Show.hs
View File

@@ -1,7 +1,8 @@
module Web.View.CollectiveProposals.Show where
import Web.View.Prelude
import IHP.ViewPrelude
import Web.View.CollectiveProposals.Index (consensusBadge)
import Data.Aeson (Value)
data ShowView = ShowView
{ proposal :: !CollectiveProposal
@@ -20,18 +21,9 @@ instance View ShowView where
{consensusBadge proposal.consensusStatus}
</div>
{case proposal.summary of
Nothing -> mempty
Just s -> [hsx|<p class="text-gray-700">{s}</p>|]}
{maybe mempty renderProposalSummary proposal.summary}
{case proposal.finalContent of
Nothing -> mempty
Just fc -> [hsx|
<div class="bg-green-50 border border-green-200 rounded-lg p-4">
<h2 class="text-sm font-semibold text-green-800 mb-2">Synthesized Recommendation</h2>
<pre class="text-sm text-green-900 whitespace-pre-wrap">{show fc}</pre>
</div>
|]}
{maybe mempty renderFinalContent proposal.finalContent}
<div>
<h2 class="text-lg font-semibold text-gray-800 mb-3">
@@ -43,16 +35,28 @@ instance View ShowView where
</div>
</div>
|]
where
renderContrib (contrib, agentName) = [hsx|
<div class="bg-white shadow rounded-lg p-4">
<div class="flex justify-between items-center mb-2">
<span class="text-sm font-medium text-gray-800">{agentName}</span>
<span class="text-xs text-gray-400">
{maybe "" (\m -> "model: " <> m) contrib.modelUsed}
{maybe "" (\t -> " · " <> show t <> " tokens out") contrib.tokensOut}
</span>
</div>
<pre class="text-sm text-gray-700 whitespace-pre-wrap bg-gray-50 rounded p-3">{show contrib.content}</pre>
</div>
|]
renderProposalSummary :: Text -> Html
renderProposalSummary s = [hsx|<p class="text-gray-700">{s}</p>|]
renderFinalContent :: Value -> Html
renderFinalContent fc = [hsx|
<div class="bg-green-50 border border-green-200 rounded-lg p-4">
<h2 class="text-sm font-semibold text-green-800 mb-2">Synthesized Recommendation</h2>
<pre class="text-sm text-green-900 whitespace-pre-wrap">{show fc}</pre>
</div>
|]
renderContrib :: (CollectiveProposalContribution, Text) -> Html
renderContrib (contrib, agentName) = [hsx|
<div class="bg-white shadow rounded-lg p-4">
<div class="flex justify-between items-center mb-2">
<span class="text-sm font-medium text-gray-800">{agentName}</span>
<span class="text-xs text-gray-400">
{maybe "" (\m -> "model: " <> m) contrib.modelUsed}
{maybe "" (\t -> " · " <> show t <> " tokens out") contrib.tokensOut}
</span>
</div>
<pre class="text-sm text-gray-700 whitespace-pre-wrap bg-gray-50 rounded p-3">{show contrib.content}</pre>
</div>
|]

118
Web/View/CrossHubPropagations/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data IndexView = IndexView
{ propagations :: ![CrossHubPropagation]
@@ -20,65 +21,68 @@ instance View IndexView where
</a>
</div>
{if null propagations
then [hsx|<p class="text-sm text-gray-400">No propagation events detected yet.</p>|]
else [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Pattern</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Summary</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Source Hub</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Status</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Detected</th>
<th class="px-4 py-3"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach propagations renderRow}
</tbody>
</table>
</div>
|]}
{renderPropagationsList propagations hubs}
|]
where
hubName hid = maybe "–" (.name) (find (\h -> h.id == hid) hubs)
renderPropagationsList :: [CrossHubPropagation] -> [Hub] -> Html
renderPropagationsList [] _ = [hsx|<p class="text-sm text-gray-400">No propagation events detected yet.</p>|]
renderPropagationsList propagations hubs = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Pattern</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Summary</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Source Hub</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Status</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Detected</th>
<th class="px-4 py-3"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach propagations (renderPropRow hubs)}
</tbody>
</table>
</div>
|]
renderRow :: CrossHubPropagation -> Html
renderRow p = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3">
<span class="bg-purple-100 text-purple-700 text-xs px-1.5 py-0.5 rounded">
{p.patternType}
</span>
</td>
<td class="px-4 py-3 text-gray-700">{p.summary}</td>
<td class="px-4 py-3 text-gray-500 text-xs">
{maybe "–" hubName p.sourceHubId}
</td>
<td class="px-4 py-3">
<span class={statusBadge p.status <> " text-xs px-2 py-0.5 rounded font-medium"}>
{p.status}
</span>
</td>
<td class="px-4 py-3 text-xs text-gray-400">{show p.detectedAt}</td>
<td class="px-4 py-3 text-right">
{if p.status == "open"
then [hsx|
<a href={AcknowledgePropagationAction { crossHubPropagationId = p.id }}
class="text-xs text-yellow-600 hover:underline mr-2">Acknowledge</a>
|]
else mempty}
{if p.status /= "resolved"
then [hsx|
<a href={ResolvePropagationAction { crossHubPropagationId = p.id }}
class="text-xs text-green-600 hover:underline">Resolve</a>
|]
else mempty}
</td>
</tr>
|]
renderPropRow :: [Hub] -> CrossHubPropagation -> Html
renderPropRow hubs p =
let hubName hid = maybe "–" (.name) (find (\h -> h.id == hid) hubs)
in [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3">
<span class="bg-purple-100 text-purple-700 text-xs px-1.5 py-0.5 rounded">
{p.patternType}
</span>
</td>
<td class="px-4 py-3 text-gray-700">{p.summary}</td>
<td class="px-4 py-3 text-gray-500 text-xs">
{maybe "–" hubName p.sourceHubId}
</td>
<td class="px-4 py-3">
<span class={statusBadge p.status <> " text-xs px-2 py-0.5 rounded font-medium"}>
{p.status}
</span>
</td>
<td class="px-4 py-3 text-xs text-gray-400">{show p.detectedAt}</td>
<td class="px-4 py-3 text-right">
{renderAcknowledgeLink p}
{renderResolveLink p}
</td>
</tr>
|]
renderAcknowledgeLink :: CrossHubPropagation -> Html
renderAcknowledgeLink p
| p.status == "open" = [hsx|<a href={AcknowledgePropagationAction (p.id)}
class="text-xs text-yellow-600 hover:underline mr-2">Acknowledge</a>|]
| otherwise = mempty
renderResolveLink :: CrossHubPropagation -> Html
renderResolveLink p
| p.status /= "resolved" = [hsx|<a href={ResolvePropagationAction (p.id)}
class="text-xs text-green-600 hover:underline">Resolve</a>|]
| otherwise = mempty
statusBadge :: Text -> Text
statusBadge s = case s of

3
Web/View/DecisionRecords/Edit.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Web.View.DecisionRecords.New (renderForm)
data EditView = EditView
@@ -18,7 +19,7 @@ instance View EditView where
<div class="mb-6 flex items-center gap-2 text-sm text-gray-500">
<a href={DecisionRecordsAction} class="hover:text-gray-700">Decisions</a>
<span>/</span>
<a href={ShowDecisionRecordAction { decisionRecordId = record.id }}
<a href={ShowDecisionRecordAction (record.id)}
class="hover:text-gray-700">{record.title}</a>
<span>/</span>
<span>Edit</span>

25
Web/View/DecisionRecords/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data IndexView = IndexView
{ records :: ![DecisionRecord]
@@ -29,17 +30,21 @@ instance View IndexView where
<div class="flex gap-2 mb-5 text-sm flex-wrap">
<a href={DecisionRecordsAction}
class={filterTabClass Nothing mOutcomeFilter}>All</a>
{forEach allOutcomes (\o -> [hsx|
<a href={decisionFilterUrl o}
class={filterTabClass (Just o) mOutcomeFilter}>{o}</a>
|])}
{forEach allOutcomes (renderOutcomeTab mOutcomeFilter)}
</div>
{if null records
then [hsx|<p class="text-sm text-gray-400">No decision records found.</p>|]
else renderTable records requirements users}
{if null records then noDecisionsMsg else renderTable records requirements users}
|]
noDecisionsMsg :: Html
noDecisionsMsg = [hsx|<p class="text-sm text-gray-400">No decision records found.</p>|]
renderOutcomeTab :: Maybe Text -> Text -> Html
renderOutcomeTab mOutcomeFilter o = [hsx|
<a href={decisionFilterUrl o}
class={filterTabClass (Just o) mOutcomeFilter}>{o}</a>
|]
decisionFilterUrl :: Text -> Text
decisionFilterUrl o = "/DecisionRecords?outcome=" <> o
@@ -67,7 +72,7 @@ renderRow :: [Requirement] -> [User] -> DecisionRecord -> Html
renderRow reqs users dr = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3">
<a href={ShowDecisionRecordAction { decisionRecordId = dr.id }}
<a href={ShowDecisionRecordAction (dr.id)}
class="text-indigo-600 hover:text-indigo-800 font-medium">{dr.title}</a>
</td>
<td class="px-4 py-3">
@@ -89,9 +94,9 @@ linkedReqTitle :: [Requirement] -> Maybe (Id Requirement) -> Text
linkedReqTitle _ Nothing = "—"
linkedReqTitle reqs (Just rid) = maybe "(unknown)" (.title) (find (\r -> r.id == rid) reqs)
userName :: [User] -> Maybe (Id User) -> Text
userName :: [User] -> Maybe UUID -> Text
userName _ Nothing = "—"
userName users (Just uid) = maybe "(unknown)" (.name) (find (\u -> u.id == uid) users)
userName users (Just uid) = maybe "(unknown)" (.name) (find (\u -> toUUID u.id == uid) users)
outcomeClass :: Text -> Text
outcomeClass "accepted" = "bg-green-100 text-green-800"

15
Web/View/DecisionRecords/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView
{ record :: !DecisionRecord
@@ -29,8 +30,6 @@ instance View NewView where
renderForm :: DecisionRecord -> [Requirement] -> [RequirementCandidate] -> [User] -> action -> Html
renderForm record requirements candidates users submitAction = [hsx|
<form method="POST" action={submitAction} class="bg-white rounded-lg border border-gray-200 px-6 py-5 space-y-4">
{hiddenField "authenticity_token"}
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Title</label>
<input type="text" name="title" value={record.title}
@@ -64,7 +63,7 @@ renderForm record requirements candidates users submitAction = [hsx|
<select name="requirementId"
class="w-full border border-gray-300 rounded px-3 py-2 text-sm focus:outline-none focus:ring-2 focus:ring-indigo-500">
<option value="">— None —</option>
{forEach requirements (\r -> [hsx|<option value={show r.id}>{r.title}</option>|])}
{forEach requirements renderRequirementOption}
</select>
</div>
@@ -73,7 +72,7 @@ renderForm record requirements candidates users submitAction = [hsx|
<select name="candidateId"
class="w-full border border-gray-300 rounded px-3 py-2 text-sm focus:outline-none focus:ring-2 focus:ring-indigo-500">
<option value="">— None —</option>
{forEach candidates (\c -> [hsx|<option value={show c.id}>{c.title}</option>|])}
{forEach candidates renderCandidateOption}
</select>
</div>
@@ -82,7 +81,7 @@ renderForm record requirements candidates users submitAction = [hsx|
<textarea name="notes" rows="2"
class="w-full border border-gray-300 rounded px-3 py-2 text-sm focus:outline-none focus:ring-2 focus:ring-indigo-500"
placeholder="For split/merged: list related candidate IDs or context"
>{maybe "" id record.notes}</textarea>
>{fromMaybe "" record.notes}</textarea>
</div>
<div class="flex gap-3 pt-2">
@@ -95,3 +94,9 @@ renderForm record requirements candidates users submitAction = [hsx|
</div>
</form>
|]
renderRequirementOption :: Requirement -> Html
renderRequirementOption r = [hsx|<option value={show r.id}>{r.title}</option>|]
renderCandidateOption :: RequirementCandidate -> Html
renderCandidateOption c = [hsx|<option value={show c.id}>{c.title}</option>|]

61
Web/View/DecisionRecords/Show.hs
View File

@@ -4,6 +4,8 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Int (Int16)
data ShowView = ShowView
{ record :: !DecisionRecord
@@ -33,7 +35,7 @@ instance View ShowView where
<span class={outcomeClass record.outcome <> " text-xs px-2 py-0.5 rounded font-medium"}>
{record.outcome}
</span>
<a href={EditDecisionRecordAction { decisionRecordId = record.id }}
<a href={EditDecisionRecordAction (record.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Edit
</a>
@@ -52,12 +54,7 @@ instance View ShowView where
<!-- Linked requirement -->
<div class="bg-white rounded-lg border border-gray-200 px-6 py-4">
<h2 class="text-sm font-semibold text-gray-700 mb-2">Linked Requirement</h2>
{case mRequirement of
Nothing -> [hsx|<p class="text-sm text-gray-400">No requirement linked.</p>|]
Just req -> [hsx|
<a href={ShowRequirementAction { requirementId = req.id }}
class="text-sm text-indigo-600 hover:text-indigo-800">{req.title}</a>
|]}
{renderLinkedRequirement mRequirement}
</div>
<!-- Source candidate -->
@@ -67,7 +64,7 @@ instance View ShowView where
<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">Policy References</h2>
{forEach policyRefs renderPolicyRef}
<form method="POST" action={AddPolicyReferenceAction { decisionRecordId = record.id }}
<form method="POST" action={AddPolicyReferenceAction (record.id)}
class="mt-3 flex items-end gap-2">
{hiddenField "authenticity_token"}
<div>
@@ -98,32 +95,23 @@ instance View ShowView where
<div class="bg-white rounded-lg border border-gray-200 px-6 py-4">
<div class="flex items-center justify-between mb-3">
<h2 class="text-sm font-semibold text-gray-700">Deployments</h2>
{if null implRefs
then mempty
else [hsx|
<a href={(pathTo NewDeploymentRecordAction) <> "?decisionId=" <> show record.id}
class="text-xs border border-indigo-300 text-indigo-600 px-3 py-1 rounded hover:bg-indigo-50">
New Deployment
</a>
|]}
{if null implRefs then mempty else renderNewDeploymentLink record.id}
</div>
{if null deploymentRecords
then [hsx|<p class="text-sm text-gray-400">No deployments recorded yet.</p>|]
else [hsx|{forEach deploymentRecords (renderDeploymentRow evaluations)}|]}
{if null deploymentRecords then noDeploymentsMsg else forEach deploymentRecords (renderDeploymentRow evaluations)}
</div>
<!-- Implementation references -->
<div class="bg-white rounded-lg border border-gray-200 px-6 py-4">
<div class="flex items-center justify-between mb-3">
<h2 class="text-sm font-semibold text-gray-700">Implementation References</h2>
<form method="POST" action={ProposeImplementationAction { decisionRecordId = record.id }} class="inline">
<form method="POST" action={ProposeImplementationAction (record.id)} class="inline">
<button type="submit" class="text-xs border border-green-300 text-green-700 px-2 py-1 rounded hover:bg-green-50">
Propose Implementation
</button>
</form>
</div>
{forEach implRefs renderImplRef}
<form method="POST" action={AddImplementationRefAction { decisionRecordId = record.id }}
<form method="POST" action={AddImplementationRefAction (record.id)}
class="mt-3 flex items-end gap-2">
{hiddenField "authenticity_token"}
<div>
@@ -163,7 +151,7 @@ renderCandidateSection :: RequirementCandidate -> Html
renderCandidateSection c = [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-2">Source Candidate</h2>
<a href={ShowRequirementCandidateAction { requirementCandidateId = c.id }}
<a href={ShowRequirementCandidateAction (c.id)}
class="text-sm text-indigo-600 hover:text-indigo-800">{c.title}</a>
</div>
|]
@@ -175,11 +163,11 @@ renderPolicyRef ref = [hsx|
<span class={policyScopeClass ref.policyScope <> " text-xs px-2 py-0.5 rounded font-medium"}>
{ref.policyScope}
</span>
{maybe mempty (\n -> [hsx|<span class="text-gray-600">{n}</span>|]) ref.constraintNote}
{maybe mempty renderConstraintNote ref.constraintNote}
<span class="text-xs text-gray-400">{show ref.createdAt}</span>
</div>
<form method="POST"
action={DeletePolicyReferenceAction { policyReferenceId = ref.id }}>
action={DeletePolicyReferenceAction (ref.id)}>
{hiddenField "authenticity_token"}
<button type="submit"
class="text-xs text-red-500 hover:text-red-700 ml-2">Remove</button>
@@ -198,7 +186,7 @@ renderImplRef ref = [hsx|
<span class="text-xs text-gray-400">{show ref.linkedAt}</span>
</div>
<form method="POST"
action={DeleteImplementationRefAction { implementationChangeReferenceId = ref.id }}>
action={DeleteImplementationRefAction (ref.id)}>
{hiddenField "authenticity_token"}
<button type="submit"
class="text-xs text-red-500 hover:text-red-700 ml-2">Remove</button>
@@ -228,11 +216,32 @@ 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|<p class="text-sm text-gray-400">No requirement linked.</p>|]
renderLinkedRequirement (Just req) = [hsx|
<a href={ShowRequirementAction (req.id)}
class="text-sm text-indigo-600 hover:text-indigo-800">{req.title}</a>
|]
renderNewDeploymentLink :: Id DecisionRecord -> Html
renderNewDeploymentLink recordId = [hsx|
<a href={(pathTo NewDeploymentRecordAction) <> "?decisionId=" <> show recordId}
class="text-xs border border-indigo-300 text-indigo-600 px-3 py-1 rounded hover:bg-indigo-50">
New Deployment
</a>
|]
noDeploymentsMsg :: Html
noDeploymentsMsg = [hsx|<p class="text-sm text-gray-400">No deployments recorded yet.</p>|]
renderConstraintNote :: Text -> Html
renderConstraintNote n = [hsx|<span class="text-gray-600">{n}</span>|]
renderDeploymentRow :: [ChangeEvaluation] -> DeploymentRecord -> Html
renderDeploymentRow evals dr = [hsx|
<div class="flex items-center justify-between py-2 border-b border-gray-100 last:border-0">
<div class="flex items-center gap-2 text-sm">
<a href={ShowDeploymentRecordAction { deploymentRecordId = dr.id }}
<a href={ShowDeploymentRecordAction (dr.id)}
class="font-mono text-indigo-600 hover:text-indigo-800">{dr.versionRef}</a>
<span class="text-xs text-gray-400">{show dr.deployedAt}</span>
</div>

17
Web/View/DeploymentRecords/Index.hs
View File

@@ -4,6 +4,8 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Int (Int16)
data IndexView = IndexView
{ records :: ![DeploymentRecord]
@@ -22,11 +24,12 @@ instance View IndexView where
</a>
</div>
{if null records
then [hsx|<p class="text-gray-500 text-sm">No deployment records yet.</p>|]
else renderTable records decisions signals evaluations}
{if null records then noDeployments else renderTable records decisions signals evaluations}
|]
noDeployments :: Html
noDeployments = [hsx|<p class="text-gray-500 text-sm">No deployment records yet.</p>|]
renderTable :: [DeploymentRecord] -> [DecisionRecord] -> [OutcomeSignal] -> [ChangeEvaluation] -> Html
renderTable records decisions signals evaluations = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
@@ -51,14 +54,14 @@ renderRow :: [DecisionRecord] -> [OutcomeSignal] -> [ChangeEvaluation] -> Deploy
renderRow decisions signals evaluations record = [hsx|
<tr class="border-b border-gray-100 hover:bg-gray-50 last:border-0">
<td class="px-4 py-3">
<a href={ShowDeploymentRecordAction { deploymentRecordId = record.id }}
<a href={ShowDeploymentRecordAction (record.id)}
class="text-indigo-600 hover:text-indigo-800">{decisionTitle}</a>
</td>
<td class="px-4 py-3 font-mono text-gray-700">{record.versionRef}</td>
<td class="px-4 py-3 text-gray-500">{show record.deployedAt}</td>
<td class="px-4 py-3 text-right text-gray-600">{show signalCount}</td>
<td class="px-4 py-3 text-right">
{maybe [hsx|<span class="text-gray-400">—</span>|] renderScoreBadge mScore}
{renderMaybeScore mScore}
</td>
</tr>
|]
@@ -69,6 +72,10 @@ renderRow decisions signals evaluations record = [hsx|
mScore :: Maybe Int16
mScore = fmap (.score) $ find (\e -> e.deploymentId == record.id) evaluations
renderMaybeScore :: Maybe Int16 -> Html
renderMaybeScore Nothing = [hsx|<span class="text-gray-400">—</span>|]
renderMaybeScore (Just score) = renderScoreBadge score
renderScoreBadge :: Int16 -> Html
renderScoreBadge score = [hsx|
<span class={scoreClass score <> " text-xs px-2 py-0.5 rounded font-medium"}>

4
Web/View/DeploymentRecords/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView
{ record :: !DeploymentRecord
@@ -26,8 +27,6 @@ instance View NewView where
<form method="POST" action={CreateDeploymentRecordAction}
class="bg-white rounded-lg border border-gray-200 px-6 py-5 space-y-4">
{hiddenField "authenticity_token"}
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">
Decision <span class="text-red-500">*</span>
@@ -57,7 +56,6 @@ instance View NewView where
value={record.versionRef}
placeholder="e.g. v1.2.3, git:abc1234, deploy/2026-03-29"
class="w-full text-sm border border-gray-300 rounded px-3 py-2" />
{validationErrorsFor record #versionRef}
</div>
<div>

24
Web/View/DeploymentRecords/Show.hs
View File

@@ -4,6 +4,8 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Int (Int16)
data PeriodMetrics = PeriodMetrics
{ eventCount :: !Int
@@ -59,7 +61,7 @@ instance View ShowView where
<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 { decisionRecordId = decision.id }}
<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}
@@ -75,12 +77,10 @@ instance View ShowView where
<!-- 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>
{if null signals
then [hsx|<p class="text-sm text-gray-400 mb-3">No signals recorded yet.</p>|]
else [hsx|<div class="mb-4">{forEach signals renderSignal}</div>|]}
<form method="POST" action={RecordOutcomeSignalAction { deploymentRecordId = record.id }}
{renderSignalsSection signals}
<form method="POST" action={RecordOutcomeSignalAction (record.id)}
class="flex items-end gap-2 mt-2">
{hiddenField "authenticity_token"}
<div>
<label class="text-xs text-gray-500 block mb-1">Signal type</label>
<select name="signalType"
@@ -136,7 +136,7 @@ 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 { requirementId = req.id }}
<a href={ShowRequirementAction (req.id)}
class="text-indigo-600 hover:text-indigo-800">{req.title}</a>
</div>
|]
@@ -145,7 +145,7 @@ 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 { requirementCandidateId = c.id }}
<a href={ShowRequirementCandidateAction (c.id)}
class="text-indigo-600 hover:text-indigo-800">{c.title}</a>
</div>
|]
@@ -154,11 +154,15 @@ 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 { widgetId = w.id }}
<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">
@@ -177,7 +181,7 @@ renderSignalValue v = [hsx|
renderNoEvaluationForm :: Id DeploymentRecord -> Html
renderNoEvaluationForm deploymentRecordId = [hsx|
<form method="POST" action={EvaluateChangeAction { deploymentRecordId }}
<form method="POST" action={EvaluateChangeAction deploymentRecordId}
class="space-y-3">
{hiddenField "authenticity_token"}
<div>

10
Web/View/EnvelopeEmissionContracts/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Application.Helper.View (adapterStatusBadge)
data IndexView = IndexView
@@ -25,11 +26,12 @@ instance View IndexView where
</a>
</div>
{if null contracts
then [hsx|<p class="text-sm text-gray-400">No contracts found.</p>|]
else renderTable contracts}
{if null contracts then noContractsMsg else renderTable contracts}
|]
noContractsMsg :: Html
noContractsMsg = [hsx|<p class="text-sm text-gray-400">No contracts found.</p>|]
renderTable :: [EnvelopeEmissionContract] -> Html
renderTable contracts = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
@@ -53,7 +55,7 @@ renderRow :: EnvelopeEmissionContract -> Html
renderRow c = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3">
<a href={ShowEnvelopeEmissionContractAction { envelopeEmissionContractId = c.id }}
<a href={ShowEnvelopeEmissionContractAction (c.id)}
class="font-mono text-indigo-600 hover:underline">v{c.contractVersion}</a>
</td>
<td class="px-4 py-3 text-gray-600 font-mono text-xs">{tshow c.requiredAttributes}</td>

8
Web/View/EnvelopeEmissionContracts/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Application.Helper.View (adapterStatusBadge)
data ShowView = ShowView
@@ -28,9 +29,7 @@ instance View ShowView where
{maturityBadge contract.maturity}
</div>
{forEach (contractDescription contract) (\d -> [hsx|
<p class="text-sm text-gray-600 mb-6">{d}</p>
|])}
{forEach (contractDescription contract) renderContractDescription}
<div class="grid grid-cols-1 gap-4">
<div class="bg-white rounded-lg border border-gray-200 p-5">
@@ -54,6 +53,9 @@ instance View ShowView where
</div>
|]
renderContractDescription :: Text -> Html
renderContractDescription d = [hsx|<p class="text-sm text-gray-600 mb-6">{d}</p>|]
contractDescription :: EnvelopeEmissionContract -> [Text]
contractDescription c = case c.description of
Just d -> [d]

115
Web/View/FederatedGovernance/Dashboard.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import qualified Data.List as List
data FederatedGovernanceDashboardView = FederatedGovernanceDashboardView
@@ -80,7 +81,7 @@ instance View FederatedGovernanceDashboardView where
-- ── Panel 2: Routing activity ─────────────────────────────────────
activeRulesCount = length rules
routedCount = length routedCandidates
hubName hid = maybe (show hid) (.name) (find (\h -> h.id == hid) hubs)
hubName hid = maybe (show hid) (.name) (find (\h -> toUUID h.id == hid) hubs)
panel2Routing = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5">
@@ -99,29 +100,34 @@ instance View FederatedGovernanceDashboardView where
<div class="text-xs text-gray-500">routed (30 days)</div>
</div>
</div>
{if null rules
then [hsx|<p class="text-xs text-gray-400">No active routing rules.</p>|]
else [hsx|
<div class="space-y-1">
{forEach (take 5 rules) renderRuleRow}
</div>
|]}
{renderRulesSection rules}
</div>
|]
renderRulesSection :: [HubRoutingRule] -> Html
renderRulesSection [] = [hsx|<p class="text-xs text-gray-400">No active routing rules.</p>|]
renderRulesSection rs = [hsx|
<div class="space-y-1">
{forEach (take 5 rs) renderRuleRow}
</div>
|]
renderRuleRow :: HubRoutingRule -> Html
renderRuleRow r = [hsx|
<div class="flex items-center gap-2 text-xs text-gray-600">
<span class="font-medium">{hubName r.sourceHubId}</span>
<span class="text-gray-400">→</span>
<span class="font-medium">{hubName r.targetHubId}</span>
{maybe mempty (\c -> [hsx|<span class="text-gray-400">({c})</span>|]) r.matchCategory}
{maybe mempty renderMatchCategory r.matchCategory}
</div>
|]
renderMatchCategory :: Text -> Html
renderMatchCategory c = [hsx|<span class="text-gray-400">({c})</span>|]
-- ── Panel 3: Policy compliance ────────────────────────────────────
activeOverlaysCount = length overlays
decisionIdsWithPolicy = List.nub $ map (.requirementId) allPolicies
decisionIdsWithPolicy = List.nub $ map (Just . (.decisionId)) allPolicies
coveredDecisions = length $ filter (\d -> Just d.id `elem` decisionIdsWithPolicy) allDecisions
totalDecisions = length allDecisions
policyPct :: Int
@@ -145,15 +151,7 @@ instance View FederatedGovernanceDashboardView where
<div class="text-xs text-gray-500">decision coverage</div>
</div>
</div>
{if null overlays
then [hsx|<p class="text-xs text-gray-400">No active policy overlays.</p>|]
else [hsx|
<div class="space-y-1">
{forEach overlays \o -> [hsx|
<div class="text-xs text-gray-600 truncate">{o.title}</div>
|]}
</div>
|]}
{renderOverlaysList overlays}
</div>
|]
@@ -161,7 +159,7 @@ instance View FederatedGovernanceDashboardView where
hubsWithStewards = List.nub (map (.hubId) stewards)
stewardedCount = length hubsWithStewards
totalHubs = length hubs
hubsWithNoSteward = filter (\h -> h.id `notElem` hubsWithStewards) hubs
hubsWithNoSteward = filter (\h -> toUUID h.id `notElem` hubsWithStewards) hubs
panel4Stewardship = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5">
@@ -180,26 +178,13 @@ instance View FederatedGovernanceDashboardView where
<div class="text-xs text-gray-500">hubs unassigned</div>
</div>
</div>
{if null hubsWithNoSteward
then [hsx|<p class="text-xs text-green-600">All hubs have active stewards.</p>|]
else [hsx|
<div>
<p class="text-xs text-gray-500 mb-1">Hubs without stewards:</p>
<div class="flex flex-wrap gap-1">
{forEach hubsWithNoSteward \h -> [hsx|
<span class="text-xs bg-amber-100 text-amber-700 px-2 py-0.5 rounded">
{h.name}
</span>
|]}
</div>
</div>
|]}
{renderUnstewarded hubsWithNoSteward}
</div>
|]
-- ── Panel 5: Archive activity ─────────────────────────────────────
archiveByType = List.sortBy (\a b -> compare (fst a) (fst b))
$ map (\grp -> (fst (head grp), length grp))
$ map (\grp -> ((head grp).subjectType, length grp))
$ List.groupBy (\a b -> a.subjectType == b.subjectType)
$ List.sortBy (\a b -> compare a.subjectType b.subjectType) recentArchives
@@ -210,20 +195,50 @@ instance View FederatedGovernanceDashboardView where
<a href={ArchiveRecordsAction}
class="text-xs text-blue-600 hover:underline">All records →</a>
</div>
{if null recentArchives
then [hsx|<p class="text-sm text-gray-400">No artifacts archived in the last 90 days.</p>|]
else [hsx|
<div class="flex items-center gap-3 mb-2">
<div class="text-3xl font-bold text-gray-900">{show (length recentArchives)}</div>
<div class="text-xs text-gray-500">total archived artifacts</div>
</div>
<div class="flex flex-wrap gap-2">
{forEach archiveByType \(typ, cnt) -> [hsx|
<span class="text-sm bg-amber-50 border border-amber-200 text-amber-800 px-3 py-1 rounded">
{typ}: {show cnt}
</span>
|]}
</div>
|]}
{renderArchiveActivity recentArchives archiveByType}
</div>
|]
renderOverlaysList :: [FederatedPolicyOverlay] -> Html
renderOverlaysList [] = [hsx|<p class="text-xs text-gray-400">No active policy overlays.</p>|]
renderOverlaysList overlays = [hsx|
<div class="space-y-1">
{forEach overlays renderOverlayTitle}
</div>
|]
renderOverlayTitle :: FederatedPolicyOverlay -> Html
renderOverlayTitle o = [hsx|<div class="text-xs text-gray-600 truncate">{o.title}</div>|]
renderUnstewarded :: [Hub] -> Html
renderUnstewarded [] = [hsx|<p class="text-xs text-green-600">All hubs have active stewards.</p>|]
renderUnstewarded hs = [hsx|
<div>
<p class="text-xs text-gray-500 mb-1">Hubs without stewards:</p>
<div class="flex flex-wrap gap-1">
{forEach hs renderUnstewardedHub}
</div>
</div>
|]
renderUnstewardedHub :: Hub -> Html
renderUnstewardedHub h = [hsx|<span class="text-xs bg-amber-100 text-amber-700 px-2 py-0.5 rounded">{h.name}</span>|]
renderArchiveActivity :: [ArchiveRecord] -> [(Text, Int)] -> Html
renderArchiveActivity [] _ = [hsx|<p class="text-sm text-gray-400">No artifacts archived in the last 90 days.</p>|]
renderArchiveActivity archives byType = [hsx|
<div class="flex items-center gap-3 mb-2">
<div class="text-3xl font-bold text-gray-900">{show (length archives)}</div>
<div class="text-xs text-gray-500">total archived artifacts</div>
</div>
<div class="flex flex-wrap gap-2">
{forEach byType renderArchiveTypeChip}
</div>
|]
renderArchiveTypeChip :: (Text, Int) -> Html
renderArchiveTypeChip (typ, cnt) = [hsx|
<span class="text-sm bg-amber-50 border border-amber-200 text-amber-800 px-3 py-1 rounded">
{typ}: {show cnt}
</span>
|]

3
Web/View/FederatedPolicyOverlays/Edit.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data EditView = EditView
{ overlay :: !FederatedPolicyOverlay
@@ -25,6 +26,6 @@ renderForm :: FederatedPolicyOverlay -> Html
renderForm overlay = formFor overlay [hsx|
{textField #title}
{textareaField #policyText}
{(textareaField #notes){ label = "Notes (optional)" }}
{(textareaField #notes){ fieldLabel = "Notes (optional)" }}
{submitButton}
|]

78
Web/View/FederatedPolicyOverlays/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data IndexView = IndexView
{ overlays :: ![FederatedPolicyOverlay]
@@ -26,45 +27,46 @@ instance View IndexView where
</div>
</div>
{if null overlays
then [hsx|<p class="text-sm text-gray-400">No policy overlays yet.</p>|]
else [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Title</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Status</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Enforced From</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Created</th>
<th class="px-4 py-3"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach overlays renderRow}
</tbody>
</table>
</div>
|]}
{renderOverlaysList overlays}
|]
where
renderRow :: FederatedPolicyOverlay -> Html
renderRow o = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3 font-medium text-gray-800">{o.title}</td>
<td class="px-4 py-3">
<span class={statusBadge o.status <> " text-xs px-2 py-0.5 rounded font-medium"}>
{o.status}
</span>
</td>
<td class="px-4 py-3 text-xs text-gray-500">{maybe "–" show o.enforcedFrom}</td>
<td class="px-4 py-3 text-xs text-gray-400">{show o.createdAt}</td>
<td class="px-4 py-3 text-right">
<a href={ShowFederatedPolicyOverlayAction { federatedPolicyOverlayId = o.id }}
class="text-xs text-blue-600 hover:underline">View</a>
</td>
</tr>
|]
renderOverlaysList :: [FederatedPolicyOverlay] -> Html
renderOverlaysList [] = [hsx|<p class="text-sm text-gray-400">No policy overlays yet.</p>|]
renderOverlaysList overlays = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Title</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Status</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Enforced From</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Created</th>
<th class="px-4 py-3"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach overlays renderOverlayRow}
</tbody>
</table>
</div>
|]
renderOverlayRow :: FederatedPolicyOverlay -> Html
renderOverlayRow o = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3 font-medium text-gray-800">{o.title}</td>
<td class="px-4 py-3">
<span class={statusBadge o.status <> " text-xs px-2 py-0.5 rounded font-medium"}>
{o.status}
</span>
</td>
<td class="px-4 py-3 text-xs text-gray-500">{maybe "–" show o.enforcedFrom}</td>
<td class="px-4 py-3 text-xs text-gray-400">{show o.createdAt}</td>
<td class="px-4 py-3 text-right">
<a href={ShowFederatedPolicyOverlayAction (o.id)}
class="text-xs text-blue-600 hover:underline">View</a>
</td>
</tr>
|]
statusBadge :: Text -> Text
statusBadge s = case s of

3
Web/View/FederatedPolicyOverlays/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView
{ overlay :: !FederatedPolicyOverlay
@@ -22,6 +23,6 @@ renderForm :: FederatedPolicyOverlay -> Html
renderForm overlay = formFor overlay [hsx|
{textField #title}
{(textareaField #policyText){ helpText = "Full policy text; once activated this cannot be changed" }}
{(textareaField #notes){ label = "Notes (optional)" }}
{(textareaField #notes){ fieldLabel = "Notes (optional)" }}
{submitButton}
|]

27
Web/View/FederatedPolicyOverlays/PolicyComplianceDashboard.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data PolicyComplianceDashboardView = PolicyComplianceDashboardView
{ overlays :: ![FederatedPolicyOverlay]
@@ -20,17 +21,7 @@ instance View PolicyComplianceDashboardView where
class="text-sm text-gray-500 hover:underline">← All Policies</a>
</div>
{if null overlays
then [hsx|
<div class="bg-gray-50 rounded-lg border border-gray-200 p-8 text-center">
<p class="text-gray-400 text-sm">No active policy overlays.</p>
</div>
|]
else [hsx|
<div class="space-y-4">
{forEach overlays renderOverlayRow}
</div>
|]}
{renderComplianceOverlays overlays}
<div class="mt-8 bg-white rounded-lg border border-gray-200 p-6">
<h2 class="text-lg font-medium text-gray-800 mb-4">Overall Coverage</h2>
@@ -51,13 +42,25 @@ instance View PolicyComplianceDashboardView where
</div>
|]
where
decisionIdsWithPolicy = map (.requirementId) policies |> catMaybes |> map show
decisionIdsWithPolicy = map (show . (.decisionId)) policies
coveredDecisions = length $ filter (\d -> show d.id `elem` decisionIdsWithPolicy) decisions
totalDecisions = length decisions
coveragePct :: Int
coveragePct = if totalDecisions == 0 then 0
else (coveredDecisions * 100) `div` totalDecisions
renderComplianceOverlays :: [FederatedPolicyOverlay] -> Html
renderComplianceOverlays [] = [hsx|
<div class="bg-gray-50 rounded-lg border border-gray-200 p-8 text-center">
<p class="text-gray-400 text-sm">No active policy overlays.</p>
</div>
|]
renderComplianceOverlays os = [hsx|
<div class="space-y-4">
{forEach os renderOverlayRow}
</div>
|]
renderOverlayRow :: FederatedPolicyOverlay -> Html
renderOverlayRow o = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5">

48
Web/View/FederatedPolicyOverlays/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Web.View.FederatedPolicyOverlays.Index (statusBadge)
data ShowView = ShowView
@@ -40,31 +41,36 @@ instance View ShowView where
<dt class="text-gray-500">Created</dt>
<dd>{show overlay.createdAt}</dd>
</div>
{whenJust overlay.notes \n -> [hsx|
<div class="col-span-2">
<dt class="text-gray-500">Notes</dt>
<dd class="text-gray-700">{n}</dd>
</div>
|]}
{maybe mempty renderOverlayNotes overlay.notes}
</dl>
</div>
<div class="mt-4 flex gap-4">
{if overlay.status == "draft"
then [hsx|
<a href={EditFederatedPolicyOverlayAction { federatedPolicyOverlayId = overlay.id }}
class="text-sm text-blue-600 hover:underline">Edit</a>
<a href={ActivateFederatedPolicyAction { federatedPolicyOverlayId = overlay.id }}
class="text-sm text-green-600 hover:underline">Activate</a>
|]
else mempty}
{if overlay.status == "active"
then [hsx|
<a href={RetireFederatedPolicyAction { federatedPolicyOverlayId = overlay.id }}
class="text-sm text-red-600 hover:underline"
onclick="return confirm('Retire this policy overlay?')">Retire</a>
|]
else mempty}
{if overlay.status == "draft" then renderDraftActions overlay.id else mempty}
{if overlay.status == "active" then renderRetireAction overlay.id else mempty}
</div>
</div>
|]
renderDraftActions :: Id FederatedPolicyOverlay -> Html
renderDraftActions oid = [hsx|
<a href={EditFederatedPolicyOverlayAction (oid)}
class="text-sm text-blue-600 hover:underline">Edit</a>
<a href={ActivateFederatedPolicyAction (oid)}
class="text-sm text-green-600 hover:underline">Activate</a>
|]
renderRetireAction :: Id FederatedPolicyOverlay -> Html
renderRetireAction oid = [hsx|
<a href={RetireFederatedPolicyAction (oid)}
class="text-sm text-red-600 hover:underline"
onclick="return confirm('Retire this policy overlay?')">Retire</a>
|]
renderOverlayNotes :: Text -> Html
renderOverlayNotes n = [hsx|
<div class="col-span-2">
<dt class="text-gray-500">Notes</dt>
<dd class="text-gray-700">{n}</dd>
</div>
|]

15
Web/View/GovernanceTemplates/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Aeson (Value(..), decode, encode)
import qualified Data.ByteString.Lazy.Char8 as BL
@@ -28,9 +29,7 @@ instance View IndexView where
<div class="space-y-3">
{forEach templates renderTemplateRow}
{if null templates
then [hsx|<p class="text-sm text-gray-400">No published templates yet.</p>|]
else mempty}
{if null templates then noTemplatesMsg else mempty}
</div>
|]
@@ -39,11 +38,11 @@ renderTemplateRow (template, cloneCount) = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-4 hover:border-indigo-200">
<div class="flex items-center justify-between">
<div>
<a href={ShowGovernanceTemplateAction { governanceTemplateId = template.id }}
<a href={ShowGovernanceTemplateAction (template.id)}
class="font-medium text-indigo-700 hover:underline">
{template.name}
</a>
{maybe mempty (\d -> [hsx|<p class="text-xs text-gray-500 mt-0.5">{d}</p>|]) template.description}
{maybe mempty renderTemplateDesc template.description}
</div>
<span class="text-xs text-gray-400">{tshow cloneCount} clones</span>
</div>
@@ -53,6 +52,12 @@ renderTemplateRow (template, cloneCount) = [hsx|
</div>
|]
noTemplatesMsg :: Html
noTemplatesMsg = [hsx|<p class="text-sm text-gray-400">No published templates yet.</p>|]
renderTemplateDesc :: Text -> Html
renderTemplateDesc d = [hsx|<p class="text-xs text-gray-500 mt-0.5">{d}</p>|]
renderCategoryTag :: Text -> Html
renderCategoryTag cat = [hsx|
<span class="px-2 py-0.5 rounded text-xs bg-blue-100 text-blue-700 font-mono">{cat}</span>

25
Web/View/GovernanceTemplates/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView
{ template :: !GovernanceTemplate
@@ -31,9 +32,7 @@ instance View NewView where
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Hub</label>
<select name="hubId" class="w-full border border-gray-300 rounded px-3 py-2 text-sm">
{forEach hubs (\h -> [hsx|
<option value={tshow h.id}>{h.name}</option>
|])}
{forEach hubs renderHubOption}
</select>
</div>
<div>
@@ -47,13 +46,7 @@ instance View NewView where
Categories <span class="text-xs text-gray-400">(select all that apply)</span>
</label>
<div class="space-y-1 border border-gray-200 rounded p-3">
{forEach categories (\(n, l) -> [hsx|
<label class="flex items-center gap-2 text-sm">
<input type="checkbox" name="categories" value={n} />
<span class="font-mono text-xs text-gray-600">{n}</span>
<span class="text-gray-700">{l}</span>
</label>
|])}
{forEach categories renderCategoryCheckbox}
</div>
</div>
<div>
@@ -71,3 +64,15 @@ instance View NewView where
</div>
</form>
|]
renderHubOption :: Hub -> Html
renderHubOption h = [hsx|<option value={tshow h.id}>{h.name}</option>|]
renderCategoryCheckbox :: (Text, Text) -> Html
renderCategoryCheckbox (n, l) = [hsx|
<label class="flex items-center gap-2 text-sm">
<input type="checkbox" name="categories" value={n} />
<span class="font-mono text-xs text-gray-600">{n}</span>
<span class="text-gray-700">{l}</span>
</label>
|]

38
Web/View/GovernanceTemplates/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Aeson (Value(..), decode, encode)
import qualified Data.ByteString.Lazy.Char8 as BL
@@ -23,23 +24,19 @@ instance View ShowView where
<div class="flex items-center gap-3 mb-2">
<h1 class="text-2xl font-semibold">{template.name}</h1>
{if template.isPublished
then [hsx|<span class="px-2 py-0.5 rounded text-xs bg-green-100 text-green-800">published</span>|]
else [hsx|<span class="px-2 py-0.5 rounded text-xs bg-amber-100 text-amber-800">draft</span>|]}
{renderPublishedBadge template.isPublished}
</div>
<p class="text-sm text-gray-500 mb-1">Hub: {hub.name}</p>
<p class="text-sm text-gray-500 mb-4">{tshow cloneCount} clones</p>
{maybe mempty (\d -> [hsx|<p class="text-sm text-gray-600 mb-4">{d}</p>|]) template.description}
{maybe mempty renderTemplateDesc template.description}
<div class="mb-4">
<h3 class="text-sm font-semibold text-gray-700 mb-2">Categories</h3>
<div class="flex flex-wrap gap-1">
{forEach (jsonArrayTexts template.categories) renderCategoryTag}
{if null (jsonArrayTexts template.categories)
then [hsx|<span class="text-xs text-gray-400">None</span>|]
else mempty}
{if null (jsonArrayTexts template.categories) then noCategoriesBadge else mempty}
</div>
</div>
@@ -50,21 +47,32 @@ instance View ShowView where
</pre>
</div>
{if template.isPublished
then [hsx|
<a href={CloneGovernanceTemplateAction { governanceTemplateId = template.id }}
class="text-sm bg-indigo-600 text-white px-3 py-1.5 rounded hover:bg-indigo-700">
Clone to My Hub
</a>
|]
else mempty}
{if template.isPublished then renderCloneLink template.id else mempty}
|]
renderCloneLink :: Id GovernanceTemplate -> Html
renderCloneLink tid = [hsx|
<a href={CloneGovernanceTemplateAction (tid)}
class="text-sm bg-indigo-600 text-white px-3 py-1.5 rounded hover:bg-indigo-700">
Clone to My Hub
</a>
|]
renderCategoryTag :: Text -> Html
renderCategoryTag cat = [hsx|
<span class="px-2 py-0.5 rounded text-xs bg-blue-100 text-blue-700 font-mono">{cat}</span>
|]
renderPublishedBadge :: Bool -> Html
renderPublishedBadge True = [hsx|<span class="px-2 py-0.5 rounded text-xs bg-green-100 text-green-800">published</span>|]
renderPublishedBadge False = [hsx|<span class="px-2 py-0.5 rounded text-xs bg-amber-100 text-amber-800">draft</span>|]
noCategoriesBadge :: Html
noCategoriesBadge = [hsx|<span class="text-xs text-gray-400">None</span>|]
renderTemplateDesc :: Text -> Html
renderTemplateDesc d = [hsx|<p class="text-sm text-gray-600 mb-4">{d}</p>|]
jsonArrayTexts :: Value -> [Text]
jsonArrayTexts val = case decode (encode val) of
Just (arr :: [Text]) -> arr

47
Web/View/HubCapabilityManifests/Edit.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Aeson (Value(..), encode, decode)
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy.Char8 as BL
@@ -20,7 +21,7 @@ data EditView = EditView
instance View EditView where
html EditView { .. } = [hsx|
<div class="mb-4">
<a href={ShowHubCapabilityManifestAction { hubCapabilityManifestId = manifest.id }}
<a href={ShowHubCapabilityManifestAction (manifest.id)}
class="text-sm text-gray-500 hover:text-gray-700">
← {hub.name} Manifest
</a>
@@ -30,26 +31,23 @@ instance View EditView where
Declare the type names this hub owns. After saving, activate the manifest to register them.
</p>
{if manifest.status /= "draft"
then [hsx|
<div class="mb-6 bg-amber-50 border border-amber-200 rounded p-4 text-sm text-amber-800">
This manifest is <strong>{manifest.status}</strong> and is read-only.
Retire it first to create a new draft amendment.
</div>
|]
else [hsx||]}
{renderReadOnlyWarning manifest}
<form method="POST" action={UpdateHubCapabilityManifestAction { hubCapabilityManifestId = manifest.id }}>
<form method="POST" action={UpdateHubCapabilityManifestAction (manifest.id)}>
<div class="space-y-6 max-w-2xl">
<div class="bg-white rounded-lg border border-gray-200 p-5 space-y-4">
<h2 class="text-sm font-semibold text-gray-700">Manifest Details</h2>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Capability Description</label>
{(textareaField #capabilityDescription) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
<textarea name="capabilityDescription"
class="w-full border border-gray-300 rounded px-3 py-2 text-sm"
rows="3">{fromMaybe "" manifest.capabilityDescription}</textarea>
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Contact</label>
{(textField #contact) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
<input type="text" name="contact"
class="w-full border border-gray-300 rounded px-3 py-2 text-sm"
value={fromMaybe "" manifest.contact} />
</div>
</div>
@@ -64,17 +62,20 @@ instance View EditView where
{if manifest.status /= "draft" then ("disabled" :: Text) else ""}>
Save
</button>
{if manifest.status == "draft" then [hsx|
<a href={ActivateManifestAction { hubCapabilityManifestId = manifest.id }}
class="text-sm bg-green-600 text-white px-4 py-2 rounded hover:bg-green-700">
Save &amp; Activate
</a>
|] else [hsx||]}
{if manifest.status == "draft" then renderActivateLink manifest.id else mempty}
</div>
</div>
</form>
|]
renderActivateLink :: Id HubCapabilityManifest -> Html
renderActivateLink mid = [hsx|
<a href={ActivateManifestAction (mid)}
class="text-sm bg-green-600 text-white px-4 py-2 rounded hover:bg-green-700">
Save &amp; Activate
</a>
|]
-- | Render a JSON array text area with available registry options shown below.
typeArraySection :: Text -> Text -> Value -> [WidgetTypeRegistry] -> Html
typeArraySection title fieldName val entries = [hsx|
@@ -121,6 +122,16 @@ typeArraySection3 title fieldName val entries = [hsx|
</div>
|]
renderReadOnlyWarning :: HubCapabilityManifest -> Html
renderReadOnlyWarning manifest
| manifest.status /= "draft" = [hsx|
<div class="mb-6 bg-amber-50 border border-amber-200 rounded p-4 text-sm text-amber-800">
This manifest is <strong>{manifest.status}</strong> and is read-only.
Retire it first to create a new draft amendment.
</div>
|]
| otherwise = mempty
valueText :: Value -> Text
valueText v = cs (BL.unpack (encode v))

3
Web/View/HubCapabilityManifests/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Aeson (Value(..))
import qualified Data.Vector as V
@@ -56,7 +57,7 @@ renderRow hubs m = [hsx|
<td class="px-4 py-3 text-gray-500 text-xs">{jsonCount m.declaredPolicyScopes}</td>
<td class="px-4 py-3 text-gray-400 text-xs">{maybe "—" show m.activatedAt}</td>
<td class="px-4 py-3 text-right text-xs">
<a href={ShowHubCapabilityManifestAction { hubCapabilityManifestId = m.id }}
<a href={ShowHubCapabilityManifestAction (m.id)}
class="text-indigo-600 hover:text-indigo-800">View</a>
</td>
</tr>

38
Web/View/HubCapabilityManifests/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView
{ manifest :: !HubCapabilityManifest
@@ -23,33 +24,18 @@ instance View NewView where
annotation categories, and policy scopes it owns. Create a draft, declare your types,
then activate to register them with the framework.
</div>
<form method="POST" action={CreateHubCapabilityManifestAction}>
<div class="bg-white rounded-lg border border-gray-200 p-6 max-w-lg space-y-4">
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Hub</label>
{selectField #hubId (hubOptions hubs)}
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">
Capability Description <span class="text-gray-400 text-xs">(optional)</span>
</label>
{(textareaField #capabilityDescription) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">
Contact <span class="text-gray-400 text-xs">(team or person)</span>
</label>
{(textField #contact) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
<div class="pt-2">
<button type="submit"
class="bg-indigo-600 text-white text-sm px-4 py-2 rounded hover:bg-indigo-700">
Create Draft
</button>
</div>
</div>
</form>
<div class="bg-white rounded-lg border border-gray-200 p-6 max-w-lg">
{renderManifestForm manifest hubs}
</div>
|]
renderManifestForm :: HubCapabilityManifest -> [Hub] -> Html
renderManifestForm manifest hubs = formFor manifest [hsx|
{selectField #hubId (hubOptions hubs)}
{(textareaField #capabilityDescription) { fieldLabel = "Capability Description" }}
{(textField #contact) { fieldLabel = "Contact (team or person)" }}
{submitButton { label = "Create Draft" }}
|]
hubOptions :: [Hub] -> [(Text, Id Hub)]
hubOptions hubs = map (\h -> (h.name <> " (" <> h.hubKind <> ")", h.id)) hubs

65
Web/View/HubCapabilityManifests/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Aeson (Value(..), encode)
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy.Char8 as BL
@@ -26,30 +27,7 @@ instance View ShowView where
{statusBadge manifest.status}
</div>
{if manifest.status == "draft"
then [hsx|
<div class="mb-4 flex gap-2">
<a href={EditHubCapabilityManifestAction { hubCapabilityManifestId = manifest.id }}
class="text-sm border border-indigo-300 text-indigo-700 px-3 py-1.5 rounded hover:bg-indigo-50">
Edit Draft
</a>
<a href={ActivateManifestAction { hubCapabilityManifestId = manifest.id }}
class="text-sm bg-green-600 text-white px-3 py-1.5 rounded hover:bg-green-700">
Activate
</a>
</div>
|]
else if manifest.status == "active"
then [hsx|
<div class="mb-4">
<a href={RetireManifestAction { hubCapabilityManifestId = manifest.id }}
data-confirm="Retire this manifest? The hub's types will remain registered."
class="text-sm border border-gray-300 text-gray-600 px-3 py-1.5 rounded hover:bg-gray-50">
Retire
</a>
</div>
|]
else [hsx||]}
{manifestActions manifest}
<div class="grid grid-cols-2 gap-4 mb-6">
<div class="bg-white rounded-lg border border-gray-200 p-4">
@@ -62,12 +40,8 @@ instance View ShowView where
</div>
</div>
{forEach (maybeText manifest.capabilityDescription) (\d -> [hsx|
<p class="text-sm text-gray-600 mb-4">{d}</p>
|])}
{forEach (maybeText manifest.contact) (\c -> [hsx|
<p class="text-xs text-gray-400 mb-6">Contact: {c}</p>
|])}
{forEach (maybeText manifest.capabilityDescription) renderCapabilityDesc}
{forEach (maybeText manifest.contact) renderContactLine}
<div class="grid grid-cols-2 gap-4">
{jsonArraySection "Declared Widget Types" manifest.declaredWidgetTypes}
@@ -77,6 +51,37 @@ instance View ShowView where
</div>
|]
manifestActions :: HubCapabilityManifest -> Html
manifestActions manifest
| manifest.status == "draft" = [hsx|
<div class="mb-4 flex gap-2">
<a href={EditHubCapabilityManifestAction (manifest.id)}
class="text-sm border border-indigo-300 text-indigo-700 px-3 py-1.5 rounded hover:bg-indigo-50">
Edit Draft
</a>
<a href={ActivateManifestAction (manifest.id)}
class="text-sm bg-green-600 text-white px-3 py-1.5 rounded hover:bg-green-700">
Activate
</a>
</div>
|]
| manifest.status == "active" = [hsx|
<div class="mb-4">
<a href={RetireManifestAction (manifest.id)}
data-confirm="Retire this manifest? The hub's types will remain registered."
class="text-sm border border-gray-300 text-gray-600 px-3 py-1.5 rounded hover:bg-gray-50">
Retire
</a>
</div>
|]
| otherwise = mempty
renderCapabilityDesc :: Text -> Html
renderCapabilityDesc d = [hsx|<p class="text-sm text-gray-600 mb-4">{d}</p>|]
renderContactLine :: Text -> Html
renderContactLine c = [hsx|<p class="text-xs text-gray-400 mb-6">Contact: {c}</p>|]
jsonArraySection :: Text -> Value -> Html
jsonArraySection title val = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-4">

15
Web/View/HubRegistry/Index.hs
View File

@@ -1,10 +1,11 @@
module Web.View.HubRegistry.Index where
import Web.Types
import Web.Controller.HubRegistry (HubRegistryRow(..), GaafStatus(..), gaafStatus)
import Web.Types (HubRegistryRow(..), GaafStatus(..), gaafStatus)
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Aeson (Value(..))
import qualified Data.Vector as V
@@ -29,12 +30,13 @@ instance View IndexView where
<div class="space-y-3">
{forEach registryRows renderRow}
{if null registryRows
then [hsx|<p class="text-sm text-gray-400">No hubs registered yet.</p>|]
else mempty}
{if null registryRows then noHubsMsg else mempty}
</div>
|]
noHubsMsg :: Html
noHubsMsg = [hsx|<p class="text-sm text-gray-400">No hubs registered yet.</p>|]
renderRow :: HubRegistryRow -> Html
renderRow row@HubRegistryRow { hub, mManifest, mLatestSnapshot } =
let gs = gaafStatus mManifest
@@ -46,7 +48,7 @@ renderRow row@HubRegistryRow { hub, mManifest, mLatestSnapshot } =
<div class="bg-white rounded-lg border border-gray-200 p-4 hover:border-indigo-200">
<div class="flex items-center justify-between">
<div class="flex items-center gap-3">
<a href={ShowHubRegistryAction { hubId = hub.id }}
<a href={ShowHubRegistryAction (hub.id)}
class="font-medium text-indigo-700 hover:underline">
{hub.name}
</a>
@@ -74,7 +76,8 @@ gaafBadge GaafNoManifest =
healthScoreBadge :: Int -> Html
healthScoreBadge s =
let cls = if s >= 80 then "bg-green-100 text-green-800"
let cls :: Text
cls = if s >= 80 then "bg-green-100 text-green-800"
else if s >= 50 then "bg-amber-100 text-amber-800"
else "bg-red-100 text-red-700"
in [hsx|<span class={"px-2 py-0.5 rounded text-xs " <> cls}>health {tshow s}</span>|]

104
Web/View/HubRegistry/Show.hs
View File

@@ -1,10 +1,10 @@
module Web.View.HubRegistry.Show where
import Web.Types
import Web.Controller.HubRegistry (GaafStatus(..), gaafStatus)
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Aeson (Value(..), encode)
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy.Char8 as BL
@@ -47,54 +47,64 @@ instance View ShowView where
</div>
</div>
{case mManifest of
Nothing -> [hsx|
<div class="bg-amber-50 border border-amber-200 rounded p-3 mb-6 text-sm text-amber-800">
No active manifest. <a href={NewHubCapabilityManifestAction} class="underline">Create one</a> to register hub-owned types.
</div>
|]
Just m -> [hsx|
<div class="grid grid-cols-2 gap-4 mb-6">
{jsonArraySection "Widget Types" m.declaredWidgetTypes}
{jsonArraySection "Event Types" m.declaredEventTypes}
{jsonArraySection "Annotation Categories" m.declaredAnnotationCategories}
{jsonArraySection "Policy Scopes" m.declaredPolicyScopes}
</div>
|]}
{manifestSection mManifest}
<h2 class="text-lg font-semibold mb-3">Health History</h2>
{if null healthHistory
then [hsx|<p class="text-sm text-gray-400 mb-6">No snapshots recorded yet.</p>|]
else [hsx|
<div class="overflow-x-auto mb-6">
<table class="w-full text-sm">
<thead>
<tr class="text-xs text-gray-500 border-b border-gray-200">
<th class="text-left py-2">Score</th>
<th class="text-left py-2">Open Candidates</th>
<th class="text-left py-2">Regressed Widgets</th>
<th class="text-left py-2">Stale Decisions</th>
<th class="text-left py-2">Active Bottlenecks</th>
<th class="text-left py-2">Computed At</th>
</tr>
</thead>
<tbody>
{forEach healthHistory renderSnapshotRow}
</tbody>
</table>
</div>
|]}
{renderHealthHistory healthHistory}
<h2 class="text-lg font-semibold mb-3">Adopted Patterns</h2>
{if null adoptedPatterns
then [hsx|<p class="text-sm text-gray-400">No patterns adopted yet. <a href={WidgetPatternsAction} class="text-indigo-600 hover:underline">Browse patterns →</a></p>|]
else [hsx|
<div class="space-y-2">
{forEach adoptedPatterns renderAdoptedPattern}
</div>
|]}
{renderAdoptedPatternsSection adoptedPatterns}
|]
manifestSection :: Maybe HubCapabilityManifest -> Html
manifestSection Nothing = [hsx|
<div class="bg-amber-50 border border-amber-200 rounded p-3 mb-6 text-sm text-amber-800">
No active manifest. <a href={NewHubCapabilityManifestAction} class="underline">Create one</a> to register hub-owned types.
</div>
|]
manifestSection (Just m) = [hsx|
<div class="grid grid-cols-2 gap-4 mb-6">
{jsonArraySection "Widget Types" m.declaredWidgetTypes}
{jsonArraySection "Event Types" m.declaredEventTypes}
{jsonArraySection "Annotation Categories" m.declaredAnnotationCategories}
{jsonArraySection "Policy Scopes" m.declaredPolicyScopes}
</div>
|]
renderAdoptedPatternsSection :: [AdoptedPatternRow] -> Html
renderAdoptedPatternsSection [] = [hsx|<p class="text-sm text-gray-400">No patterns adopted yet. <a href={WidgetPatternsAction} class="text-indigo-600 hover:underline">Browse patterns →</a></p>|]
renderAdoptedPatternsSection ps = [hsx|
<div class="space-y-2">
{forEach ps renderAdoptedPattern}
</div>
|]
renderPinnedBadge :: Bool -> Html
renderPinnedBadge True = [hsx|<span class="px-2 py-0.5 rounded bg-blue-100 text-blue-700">pinned</span>|]
renderPinnedBadge False = [hsx|<span class="px-2 py-0.5 rounded bg-gray-100 text-gray-500">follow latest</span>|]
renderHealthHistory :: [HubHealthSnapshot] -> Html
renderHealthHistory [] = [hsx|<p class="text-sm text-gray-400 mb-6">No snapshots recorded yet.</p>|]
renderHealthHistory history = [hsx|
<div class="overflow-x-auto mb-6">
<table class="w-full text-sm">
<thead>
<tr class="text-xs text-gray-500 border-b border-gray-200">
<th class="text-left py-2">Score</th>
<th class="text-left py-2">Open Candidates</th>
<th class="text-left py-2">Regressed Widgets</th>
<th class="text-left py-2">Stale Decisions</th>
<th class="text-left py-2">Active Bottlenecks</th>
<th class="text-left py-2">Computed At</th>
</tr>
</thead>
<tbody>
{forEach history renderSnapshotRow}
</tbody>
</table>
</div>
|]
manifestCell :: Maybe HubCapabilityManifest -> Id Hub -> Html
manifestCell Nothing hubId = [hsx|
<div class="mt-1">
@@ -106,7 +116,7 @@ manifestCell Nothing hubId = [hsx|
manifestCell (Just m) _ = [hsx|
<div class="mt-1 flex items-center gap-2">
<span class="font-mono text-sm">{m.manifestVersion}</span>
<a href={ShowHubCapabilityManifestAction { hubCapabilityManifestId = m.id }}
<a href={ShowHubCapabilityManifestAction (m.id)}
class="text-xs text-indigo-600 hover:underline">View</a>
</div>
|]
@@ -163,16 +173,14 @@ renderAdoptedPattern :: AdoptedPatternRow -> Html
renderAdoptedPattern (patternId, patternName, widgetType, _, _, isPinned, adoptedAt) = [hsx|
<div class="bg-white rounded border border-gray-200 p-3 flex items-center justify-between">
<div>
<a href={ShowWidgetPatternAction { widgetPatternId = patternId }}
<a href={ShowWidgetPatternAction (patternId)}
class="font-medium text-sm text-indigo-700 hover:underline">
{patternName}
</a>
<span class="ml-2 font-mono text-xs text-gray-400">{widgetType}</span>
</div>
<div class="flex items-center gap-2 text-xs text-gray-500">
{if isPinned
then [hsx|<span class="px-2 py-0.5 rounded bg-blue-100 text-blue-700">pinned</span>|]
else [hsx|<span class="px-2 py-0.5 rounded bg-gray-100 text-gray-500">follow latest</span>|]}
{renderPinnedBadge isPinned}
<span>{tshow adoptedAt}</span>
</div>
</div>

1
Web/View/HubRoutingRules/Edit.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data EditView = EditView
{ rule :: !HubRoutingRule

101
Web/View/HubRoutingRules/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data IndexView = IndexView
{ rules :: ![HubRoutingRule]
@@ -20,56 +21,60 @@ instance View IndexView where
</a>
</div>
{if null rules
then [hsx|<p class="text-sm text-gray-400">No routing rules configured yet.</p>|]
else [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Source → Target</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Match Category</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Match Widget Type</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Priority</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Status</th>
<th class="px-4 py-3"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach rules renderRow}
</tbody>
</table>
</div>
|]}
{renderRulesList rules hubs}
|]
where
hubName hid = maybe (show hid) (.name) (find (\h -> h.id == hid) hubs)
renderRulesList :: [HubRoutingRule] -> [Hub] -> Html
renderRulesList [] _ = [hsx|<p class="text-sm text-gray-400">No routing rules configured yet.</p>|]
renderRulesList rules hubs = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Source → Target</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Match Category</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Match Widget Type</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Priority</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Status</th>
<th class="px-4 py-3"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach rules (renderRoutingRuleRow hubs)}
</tbody>
</table>
</div>
|]
renderRow :: HubRoutingRule -> Html
renderRow r = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3 font-medium text-gray-800">
{hubName r.sourceHubId} → {hubName r.targetHubId}
</td>
<td class="px-4 py-3 text-gray-500">{maybe "any" id r.matchCategory}</td>
<td class="px-4 py-3 text-gray-500">{maybe "any" id r.matchWidgetType}</td>
<td class="px-4 py-3 text-gray-600">{show r.priority}</td>
<td class="px-4 py-3">
<span class={statusBadge r.status <> " text-xs px-2 py-0.5 rounded font-medium"}>
{r.status}
</span>
</td>
<td class="px-4 py-3 text-right space-x-3">
<a href={ShowHubRoutingRuleAction { hubRoutingRuleId = r.id }}
class="text-xs text-blue-600 hover:underline">View</a>
{if r.status == "inactive"
then [hsx|<a href={ActivateRoutingRuleAction { hubRoutingRuleId = r.id }}
class="text-xs text-green-600 hover:underline">Activate</a>|]
else [hsx|<a href={DeactivateRoutingRuleAction { hubRoutingRuleId = r.id }}
class="text-xs text-gray-500 hover:underline">Deactivate</a>|]}
</td>
</tr>
|]
renderRoutingRuleRow :: [Hub] -> HubRoutingRule -> Html
renderRoutingRuleRow hubs r =
let hubName hid = maybe (show hid) (.name) (find (\h -> toUUID h.id == hid) hubs)
in [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3 font-medium text-gray-800">
{hubName r.sourceHubId} → {hubName r.targetHubId}
</td>
<td class="px-4 py-3 text-gray-500">{fromMaybe "any" r.matchCategory}</td>
<td class="px-4 py-3 text-gray-500">{fromMaybe "any" r.matchWidgetType}</td>
<td class="px-4 py-3 text-gray-600">{show r.priority}</td>
<td class="px-4 py-3">
<span class={statusBadge r.status <> " text-xs px-2 py-0.5 rounded font-medium"}>
{r.status}
</span>
</td>
<td class="px-4 py-3 text-right space-x-3">
<a href={ShowHubRoutingRuleAction (r.id)}
class="text-xs text-blue-600 hover:underline">View</a>
{renderRuleToggle r}
</td>
</tr>
|]
renderRuleToggle :: HubRoutingRule -> Html
renderRuleToggle r
| r.status == "inactive" = [hsx|<a href={ActivateRoutingRuleAction (r.id)}
class="text-xs text-green-600 hover:underline">Activate</a>|]
| otherwise = [hsx|<a href={DeactivateRoutingRuleAction (r.id)}
class="text-xs text-gray-500 hover:underline">Deactivate</a>|]
statusBadge :: Text -> Text
statusBadge s = case s of

5
Web/View/HubRoutingRules/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView
{ rule :: !HubRoutingRule
@@ -20,8 +21,8 @@ instance View NewView where
renderForm :: HubRoutingRule -> [Hub] -> Html
renderForm rule hubs = formFor rule [hsx|
{(selectField #sourceHubId hubs){ label = "Source Hub" }}
{(selectField #targetHubId hubs){ label = "Target Hub" }}
{(selectField #sourceHubId hubs){ fieldLabel = "Source Hub" }}
{(selectField #targetHubId hubs){ fieldLabel = "Target Hub" }}
{(textField #matchCategory){ helpText = "Leave blank to match any category" }}
{(textField #matchWidgetType){ helpText = "Leave blank to match any widget type" }}
{(numberField #priority){ helpText = "Higher priority rules are evaluated first" }}

78
Web/View/HubRoutingRules/RoutedCandidates.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data RoutedCandidatesView = RoutedCandidatesView
{ hub :: !Hub
@@ -22,42 +23,43 @@ instance View RoutedCandidatesView where
Requirement candidates routed to this hub from other hubs.
</p>
{if null candidates
then [hsx|<p class="text-sm text-gray-400">No candidates routed to this hub yet.</p>|]
else [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Summary</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Category</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Status</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Created</th>
<th class="px-4 py-3"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach candidates renderRow}
</tbody>
</table>
</div>
|]}
{renderRoutedCandidates candidates}
|]
where
renderRow :: RequirementCandidate -> Html
renderRow c = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3 text-gray-800">{c.summary}</td>
<td class="px-4 py-3 text-gray-500">{c.category}</td>
<td class="px-4 py-3">
<span class="text-xs bg-yellow-100 text-yellow-800 px-2 py-0.5 rounded font-medium">
{c.status}
</span>
</td>
<td class="px-4 py-3 text-xs text-gray-400">{show c.createdAt}</td>
<td class="px-4 py-3 text-right">
<a href={ShowRequirementCandidateAction { requirementCandidateId = c.id }}
class="text-xs text-blue-600 hover:underline">View</a>
</td>
</tr>
|]
renderRoutedCandidates :: [RequirementCandidate] -> Html
renderRoutedCandidates [] = [hsx|<p class="text-sm text-gray-400">No candidates routed to this hub yet.</p>|]
renderRoutedCandidates candidates = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Summary</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Category</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Status</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Created</th>
<th class="px-4 py-3"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach candidates renderCandidateRow}
</tbody>
</table>
</div>
|]
renderCandidateRow :: RequirementCandidate -> Html
renderCandidateRow c = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3 text-gray-800">{c.summary}</td>
<td class="px-4 py-3 text-gray-500">{c.category}</td>
<td class="px-4 py-3">
<span class="text-xs bg-yellow-100 text-yellow-800 px-2 py-0.5 rounded font-medium">
{c.status}
</span>
</td>
<td class="px-4 py-3 text-xs text-gray-400">{show c.createdAt}</td>
<td class="px-4 py-3 text-right">
<a href={ShowRequirementCandidateAction (c.id)}
class="text-xs text-blue-600 hover:underline">View</a>
</td>
</tr>
|]

30
Web/View/HubRoutingRules/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Web.View.HubRoutingRules.Index (statusBadge)
data ShowView = ShowView
@@ -48,25 +49,28 @@ instance View ShowView where
<dt class="text-gray-500">Created</dt>
<dd>{show rule.createdAt}</dd>
</div>
{whenJust rule.notes \n -> [hsx|
<div class="col-span-2">
<dt class="text-gray-500">Notes</dt>
<dd class="text-gray-700">{n}</dd>
</div>
|]}
{maybe mempty renderRuleNotesDt rule.notes}
</dl>
</div>
<div class="mt-4 flex gap-4">
<a href={EditHubRoutingRuleAction { hubRoutingRuleId = rule.id }}
<a href={EditHubRoutingRuleAction (rule.id)}
class="text-sm text-blue-600 hover:underline">Edit</a>
{if rule.status == "inactive"
then [hsx|<a href={ActivateRoutingRuleAction { hubRoutingRuleId = rule.id }}
class="text-sm text-green-600 hover:underline">Activate</a>|]
else [hsx|<a href={DeactivateRoutingRuleAction { hubRoutingRuleId = rule.id }}
class="text-sm text-gray-500 hover:underline">Deactivate</a>|]}
<a href={RoutedCandidatesAction { hubId = targetHub.id }}
{renderRuleToggleAction rule.id (rule.status == "inactive")}
<a href={RoutedCandidatesAction (targetHub.id)}
class="text-sm text-indigo-600 hover:underline">Routed Candidates →</a>
</div>
</div>
|]
renderRuleNotesDt :: Text -> Html
renderRuleNotesDt n = [hsx|
<div class="col-span-2">
<dt class="text-gray-500">Notes</dt>
<dd class="text-gray-700">{n}</dd>
</div>
|]
renderRuleToggleAction :: Id HubRoutingRule -> Bool -> Html
renderRuleToggleAction rid True = [hsx|<a href={ActivateRoutingRuleAction (rid)} class="text-sm text-green-600 hover:underline">Activate</a>|]
renderRuleToggleAction rid False = [hsx|<a href={DeactivateRoutingRuleAction (rid)} class="text-sm text-gray-500 hover:underline">Deactivate</a>|]

94
Web/View/Hubs/AdapterCompatibilityDashboard.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Application.Helper.View (adapterStatusBadge)
import Data.List (nub, sortBy)
import Data.Ord (comparing, Down(..))
@@ -23,7 +24,7 @@ instance View AdapterCompatibilityDashboardView where
<h1 class="text-2xl font-semibold">Adapter Compatibility Dashboard</h1>
<p class="text-sm text-gray-500">{hub.name}</p>
</div>
<a href={ShowHubAction { hubId = hub.id }}
<a href={ShowHubAction (hub.id)}
class="text-sm text-indigo-600 hover:underline">← Hub</a>
</div>
@@ -71,17 +72,11 @@ instance View AdapterCompatibilityDashboardView where
<div class="flex gap-6 text-sm">
<div>
<span class="text-gray-500 mr-1">Envelope:</span>
{forEach envelopes (\e -> [hsx|
<a href={ShowEnvelopeEmissionContractAction { envelopeEmissionContractId = e.id }}
class="font-mono text-indigo-600 hover:underline mr-2">v{e.contractVersion}</a>
|])}
{forEach envelopes renderEnvelopeLink}
</div>
<div>
<span class="text-gray-500 mr-1">Reporting:</span>
{forEach reportings (\r -> [hsx|
<a href={ShowInteractionReportingContractAction { interactionReportingContractId = r.id }}
class="font-mono text-indigo-600 hover:underline mr-2">v{r.contractVersion}</a>
|])}
{forEach reportings renderReportingLink}
</div>
</div>
</div>
@@ -92,19 +87,7 @@ instance View AdapterCompatibilityDashboardView where
Unassigned Widgets
<span class="ml-1 text-xs text-gray-400">(no adapter_spec_id)</span>
</h2>
{if null unassignedWidgets
then [hsx|<p class="text-sm text-gray-400">All widgets have adapter assignments.</p>|]
else [hsx|
<div class="text-sm text-gray-600 space-y-1">
{forEach unassignedWidgets (\w -> [hsx|
<div>
<a href={ShowWidgetAction { widgetId = w.id }}
class="text-indigo-600 hover:underline">{w.name}</a>
<span class="text-xs text-gray-400 ml-2">{w.widgetType}</span>
</div>
|])}
</div>
|]}
{renderUnassignedWidgets unassignedWidgets}
</div>
<!-- Panel 5: Stale adapters -->
@@ -112,23 +95,7 @@ instance View AdapterCompatibilityDashboardView where
<h2 class="text-sm font-semibold text-gray-700 mb-3">
Active Adapter Specs
</h2>
{if null activeSpecs
then [hsx|<p class="text-sm text-gray-400">No active adapter specs.</p>|]
else [hsx|
<table class="w-full text-sm">
<thead class="bg-gray-50">
<tr>
<th class="text-left px-3 py-2 font-medium text-gray-600">Adapter</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Framework</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Widgets</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Status</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach activeSpecs renderSpecRow}
</tbody>
</table>
|]}
{renderActiveSpecsTable activeSpecs}
</div>
|]
where
@@ -149,13 +116,31 @@ instance View AdapterCompatibilityDashboardView where
in sortBy (comparing (Down . snd))
[ (sid, length (filter (== sid) assigned)) | sid <- specIds ]
renderActiveSpecsTable :: [WidgetAdapterSpec] -> Html
renderActiveSpecsTable [] = [hsx|<p class="text-sm text-gray-400">No active adapter specs.</p>|]
renderActiveSpecsTable ss = [hsx|
<table class="w-full text-sm">
<thead class="bg-gray-50">
<tr>
<th class="text-left px-3 py-2 font-medium text-gray-600">Adapter</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Framework</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Widgets</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Status</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach ss renderSpecRow}
</tbody>
</table>
|]
renderSpecRow :: WidgetAdapterSpec -> Html
renderSpecRow s =
let widgetCount = length (filter (\w -> w.adapterSpecId == Just s.id) widgets)
in [hsx|
<tr class="hover:bg-gray-50">
<td class="px-3 py-2">
<a href={ShowWidgetAdapterSpecAction { widgetAdapterSpecId = s.id }}
<a href={ShowWidgetAdapterSpecAction (s.id)}
class="text-indigo-600 hover:underline">{s.name}</a>
</td>
<td class="px-3 py-2">
@@ -170,6 +155,35 @@ instance View AdapterCompatibilityDashboardView where
</tr>
|]
renderEnvelopeLink :: EnvelopeEmissionContract -> Html
renderEnvelopeLink e = [hsx|
<a href={ShowEnvelopeEmissionContractAction (e.id)}
class="font-mono text-indigo-600 hover:underline mr-2">v{e.contractVersion}</a>
|]
renderReportingLink :: InteractionReportingContract -> Html
renderReportingLink r = [hsx|
<a href={ShowInteractionReportingContractAction (r.id)}
class="font-mono text-indigo-600 hover:underline mr-2">v{r.contractVersion}</a>
|]
renderUnassignedWidgets :: [Widget] -> Html
renderUnassignedWidgets [] = [hsx|<p class="text-sm text-gray-400">All widgets have adapter assignments.</p>|]
renderUnassignedWidgets ws = [hsx|
<div class="text-sm text-gray-600 space-y-1">
{forEach ws renderUnassignedWidgetRow}
</div>
|]
renderUnassignedWidgetRow :: Widget -> Html
renderUnassignedWidgetRow w = [hsx|
<div>
<a href={ShowWidgetAction (w.id)}
class="text-indigo-600 hover:underline">{w.name}</a>
<span class="text-xs text-gray-400 ml-2">{w.widgetType}</span>
</div>
|]
kpiCard :: Text -> Text -> Text -> Html
kpiCard label value textClass = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-4">

76
Web/View/Hubs/AgentAuditDashboard.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data AgentAuditDashboardView = AgentAuditDashboardView
{ hub :: !Hub
@@ -19,7 +20,7 @@ instance View AgentAuditDashboardView where
<h1 class="text-2xl font-semibold">Agent Audit Dashboard</h1>
<p class="text-sm text-gray-500">{hub.name}</p>
</div>
<a href={ShowHubAction { hubId = hub.id }}
<a href={ShowHubAction (hub.id)}
class="text-sm text-indigo-600 hover:underline">← Hub</a>
</div>
@@ -35,14 +36,7 @@ instance View AgentAuditDashboardView where
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-5">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Proposals by Type</h2>
<div class="flex gap-4 flex-wrap">
{forEach allTypes (\t ->
let cnt = length (filter (\p -> p.proposalType == t) proposals)
in [hsx|
<div class="flex items-center gap-2">
<span class={typeBadge t <> " text-xs px-2 py-0.5 rounded font-medium"}>{t}</span>
<span class="text-sm font-semibold text-gray-700">{show cnt}</span>
</div>
|])}
{forEach allTypes (renderTypeCount proposals)}
</div>
</div>
@@ -51,15 +45,7 @@ instance View AgentAuditDashboardView where
<div class="px-5 py-3 border-b border-gray-100 bg-yellow-50">
<h2 class="text-sm font-semibold text-yellow-800">Unreviewed Queue ({show pendingCount})</h2>
</div>
{if null pending
then [hsx|<p class="text-sm text-gray-400 px-5 py-4">No pending proposals.</p>|]
else [hsx|
<table class="w-full text-sm">
<tbody class="divide-y divide-gray-100">
{forEach (sortByCreatedAt pending) renderQueueRow}
</tbody>
</table>
|]}
{renderPendingQueue pending}
</div>
<!-- Recent proposals (last 20) -->
@@ -90,20 +76,11 @@ instance View AgentAuditDashboardView where
<thead>
<tr>
<th class="text-left px-3 py-1 text-gray-500">Model</th>
{forEach allTypes (\t -> [hsx|
<th class="px-3 py-1 text-gray-500">{t}</th>
|])}
{forEach allTypes renderTypeHeader}
</tr>
</thead>
<tbody>
{forEach allModels (\m -> [hsx|
<tr class="border-t border-gray-100">
<td class="px-3 py-1 font-mono text-gray-600">{m}</td>
{forEach allTypes (\t ->
let cnt = length (filter (\p -> p.modelRef == m && p.proposalType == t) proposals)
in [hsx|<td class="px-3 py-1 text-center text-gray-700">{if cnt == 0 then "—" else show cnt}</td>|])}
</tr>
|])}
{forEach allModels (renderModelRow allTypes proposals)}
</tbody>
</table>
</div>
@@ -121,6 +98,23 @@ instance View AgentAuditDashboardView where
allTypes = ["summary", "requirement_draft", "duplicate_flag", "policy_flag", "impl_proposal"]
allModels = nub (map (.modelRef) proposals)
renderTypeHeader :: Text -> Html
renderTypeHeader t = [hsx|<th class="px-3 py-1 text-gray-500">{t}</th>|]
renderModelRow :: [Text] -> [AgentProposal] -> Text -> Html
renderModelRow types props m = [hsx|
<tr class="border-t border-gray-100">
<td class="px-3 py-1 font-mono text-gray-600">{m}</td>
{forEach types (renderMatrixCell props m)}
</tr>
|]
renderMatrixCell :: [AgentProposal] -> Text -> Text -> Html
renderMatrixCell props m t =
let cnt = length (filter (\p -> p.modelRef == m && p.proposalType == t) props)
display = if cnt == 0 then "—" else show cnt
in [hsx|<td class="px-3 py-1 text-center text-gray-700">{display}</td>|]
kpiCard :: Text -> Text -> Text -> Html
kpiCard label value colorClass = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-4">
@@ -139,7 +133,7 @@ renderQueueRow p = [hsx|
</td>
<td class="px-4 py-2 text-gray-400 text-xs">{show p.createdAt}</td>
<td class="px-4 py-2">
<a href={ShowAgentProposalAction { agentProposalId = p.id }}
<a href={ShowAgentProposalAction (p.id)}
class="text-xs text-indigo-600 hover:underline">Review →</a>
</td>
</tr>
@@ -149,7 +143,7 @@ renderRecentRow :: [Widget] -> AgentProposal -> Html
renderRecentRow widgets p = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-2">
<a href={ShowAgentProposalAction { agentProposalId = p.id }}
<a href={ShowAgentProposalAction (p.id)}
class={typeBadge p.proposalType <> " text-xs px-2 py-0.5 rounded font-medium"}>
{p.proposalType}
</a>
@@ -165,6 +159,26 @@ renderRecentRow widgets p = [hsx|
</tr>
|]
renderTypeCount :: [AgentProposal] -> Text -> Html
renderTypeCount proposals t =
let cnt = length (filter (\p -> p.proposalType == t) proposals)
in [hsx|
<div class="flex items-center gap-2">
<span class={typeBadge t <> " text-xs px-2 py-0.5 rounded font-medium"}>{t}</span>
<span class="text-sm font-semibold text-gray-700">{show cnt}</span>
</div>
|]
renderPendingQueue :: [AgentProposal] -> Html
renderPendingQueue [] = [hsx|<p class="text-sm text-gray-400 px-5 py-4">No pending proposals.</p>|]
renderPendingQueue pending = [hsx|
<table class="w-full text-sm">
<tbody class="divide-y divide-gray-100">
{forEach (sortByCreatedAt pending) renderQueueRow}
</tbody>
</table>
|]
widgetName :: [Widget] -> Maybe (Id Widget) -> Text
widgetName _ Nothing = "—"
widgetName widgets (Just wid) = maybe "—" (.name) (find (\w -> w.id == wid) widgets)

139
Web/View/Hubs/AntifragilityDashboard.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data AntifragilityDashboardView = AntifragilityDashboardView
{ hub :: !Hub
@@ -24,22 +25,22 @@ instance View AntifragilityDashboardView where
<div class="flex items-center gap-2 text-sm text-gray-500 mb-1">
<a href={HubsAction} class="hover:text-gray-700">Hubs</a>
<span>/</span>
<a href={ShowHubAction { hubId = hub.id }} class="hover:text-gray-700">{hub.name}</a>
<a href={ShowHubAction (hub.id)} class="hover:text-gray-700">{hub.name}</a>
<span>/</span>
<span>Antifragility</span>
</div>
<h1 class="text-2xl font-semibold">Antifragility Dashboard — {hub.name}</h1>
</div>
<div class="flex gap-2">
<a href={TriageDashboardAction { hubId = hub.id }}
<a href={TriageDashboardAction (hub.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Triage
</a>
<a href={GovernanceDashboardAction { hubId = hub.id }}
<a href={GovernanceDashboardAction (hub.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Governance
</a>
<a href={ShowHubAction { hubId = hub.id }}
<a href={ShowHubAction (hub.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Hub
</a>
@@ -67,14 +68,7 @@ instance View AntifragilityDashboardView where
</div>
<!-- Regression alerts -->
{if null regressionWidgetIds then mempty else [hsx|
<div class="bg-red-50 border border-red-200 rounded-lg px-6 py-4 mb-6">
<h2 class="text-sm font-semibold text-red-700 mb-3">⚠ Regression Alerts</h2>
<div class="flex flex-wrap gap-2">
{forEach regressedWidgets renderRegressedBadge}
</div>
</div>
|]}
{if null regressionWidgetIds then mempty else renderRegressionAlerts regressedWidgets}
<!-- Open gaps: decisions with impl refs but no deployment -->
<div class="bg-white rounded-lg border border-gray-200 px-6 py-5 mb-6">
@@ -84,56 +78,19 @@ instance View AntifragilityDashboardView where
(decisions with impl refs but no deployment recorded)
</span>
</h2>
{if null openGaps
then [hsx|<p class="text-sm text-gray-400">All decisions with impl refs have deployments.</p>|]
else [hsx|
<div class="space-y-1">
{forEach openGaps renderGapRow}
</div>
|]}
{renderOpenGaps openGaps}
</div>
<!-- Recent deployments -->
<div class="bg-white rounded-lg border border-gray-200 px-6 py-5 mb-6">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Recent Deployments</h2>
{if null recentDeploys
then [hsx|<p class="text-sm text-gray-400">No deployments yet.</p>|]
else [hsx|
<table class="w-full text-sm">
<thead class="border-b border-gray-100">
<tr>
<th class="text-left py-2 text-xs font-medium text-gray-500">Version</th>
<th class="text-left py-2 text-xs font-medium text-gray-500">Decision</th>
<th class="text-right py-2 text-xs font-medium text-gray-500">Signals</th>
<th class="text-right py-2 text-xs font-medium text-gray-500">Eval</th>
<th class="text-right py-2 text-xs font-medium text-gray-500">Deployed</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-50">
{forEach recentDeploys (renderDeployRow allDecisions allSignals allEvaluations)}
</tbody>
</table>
|]}
{renderRecentDeploysSection recentDeploys allDecisions allSignals allEvaluations}
</div>
<!-- Recurrence leaderboard -->
<div class="bg-white rounded-lg border border-gray-200 px-6 py-5">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Recurrence Leaderboard</h2>
{if null recurrenceLeaderboard
then [hsx|<p class="text-sm text-gray-400">No recurring widgets detected.</p>|]
else [hsx|
<table class="w-full text-sm">
<thead class="border-b border-gray-100">
<tr>
<th class="text-left py-2 text-xs font-medium text-gray-500">Widget</th>
<th class="text-right py-2 text-xs font-medium text-gray-500">Cycles</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-50">
{forEach recurrenceLeaderboard (renderRecurrenceRow widgets)}
</tbody>
</table>
|]}
{renderRecurrenceSection recurrenceLeaderboard widgets}
</div>
|]
where
@@ -160,7 +117,7 @@ sortByDesc f = sortBy (\a b -> compare (f b) (f a))
renderRegressedBadge :: Widget -> Html
renderRegressedBadge w = [hsx|
<a href={ShowWidgetAction { widgetId = w.id }}
<a href={ShowWidgetAction (w.id)}
class="text-xs bg-red-100 text-red-800 border border-red-300 rounded px-2 py-1 hover:bg-red-200">
{w.name}
</a>
@@ -169,7 +126,7 @@ renderRegressedBadge w = [hsx|
renderGapRow :: DecisionRecord -> Html
renderGapRow d = [hsx|
<div class="flex items-center justify-between py-1.5 text-sm">
<a href={ShowDecisionRecordAction { decisionRecordId = d.id }}
<a href={ShowDecisionRecordAction (d.id)}
class="text-indigo-600 hover:text-indigo-800">{d.title}</a>
<span class={outcomeClass d.outcome <> " text-xs px-2 py-0.5 rounded font-medium"}>
{d.outcome}
@@ -181,7 +138,7 @@ renderDeployRow :: [DecisionRecord] -> [OutcomeSignal] -> [ChangeEvaluation] ->
renderDeployRow decisions signals evals dr = [hsx|
<tr>
<td class="py-2 pr-4">
<a href={ShowDeploymentRecordAction { deploymentRecordId = dr.id }}
<a href={ShowDeploymentRecordAction (dr.id)}
class="font-mono text-indigo-600 hover:text-indigo-800">{dr.versionRef}</a>
</td>
<td class="py-2 pr-4 text-gray-600">{decisionTitle}</td>
@@ -189,7 +146,7 @@ renderDeployRow decisions signals evals dr = [hsx|
{renderSignalSummary drSignals}
</td>
<td class="py-2 pr-4 text-right">
{maybe [hsx|<span class="text-gray-400 text-xs">—</span>|] renderEvalBadge mScore}
{maybe noEvalBadge renderEvalBadge mScore}
</td>
<td class="py-2 text-right text-xs text-gray-400">{show dr.deployedAt}</td>
</tr>
@@ -203,9 +160,7 @@ renderSignalSummary :: [OutcomeSignal] -> Html
renderSignalSummary [] = [hsx|<span class="text-gray-400 text-xs">—</span>|]
renderSignalSummary signals = [hsx|
<div class="flex gap-1 justify-end">
{forEach (take 3 signals) (\s -> [hsx|
<span class={signalDot s.signalType}></span>
|])}
{forEach (take 3 signals) renderSignalDot}
</div>
|]
@@ -227,7 +182,7 @@ renderRecurrenceRow :: [Widget] -> (Id Widget, Int) -> Html
renderRecurrenceRow widgets (wid, count) = [hsx|
<tr>
<td class="py-2">
{maybe [hsx|<span class="text-gray-500">—</span>|] renderWidgetLink mWidget}
{maybe noWidgetSpan renderWidgetLink mWidget}
</td>
<td class="py-2 text-right">
<span class="text-sm font-semibold text-yellow-700">⟳ {show count}</span>
@@ -239,10 +194,72 @@ renderRecurrenceRow widgets (wid, count) = [hsx|
renderWidgetLink :: Widget -> Html
renderWidgetLink w = [hsx|
<a href={ShowWidgetAction { widgetId = w.id }}
<a href={ShowWidgetAction (w.id)}
class="text-indigo-600 hover:text-indigo-800">{w.name}</a>
|]
renderRegressionAlerts :: [Widget] -> Html
renderRegressionAlerts ws = [hsx|
<div class="bg-red-50 border border-red-200 rounded-lg px-6 py-4 mb-6">
<h2 class="text-sm font-semibold text-red-700 mb-3">⚠ Regression Alerts</h2>
<div class="flex flex-wrap gap-2">
{forEach ws renderRegressedBadge}
</div>
</div>
|]
renderOpenGaps :: [DecisionRecord] -> Html
renderOpenGaps [] = [hsx|<p class="text-sm text-gray-400">All decisions with impl refs have deployments.</p>|]
renderOpenGaps gaps = [hsx|
<div class="space-y-1">
{forEach gaps renderGapRow}
</div>
|]
renderRecentDeploysSection :: [DeploymentRecord] -> [DecisionRecord] -> [OutcomeSignal] -> [ChangeEvaluation] -> Html
renderRecentDeploysSection [] _ _ _ = [hsx|<p class="text-sm text-gray-400">No deployments yet.</p>|]
renderRecentDeploysSection deploys decisions signals evals = [hsx|
<table class="w-full text-sm">
<thead class="border-b border-gray-100">
<tr>
<th class="text-left py-2 text-xs font-medium text-gray-500">Version</th>
<th class="text-left py-2 text-xs font-medium text-gray-500">Decision</th>
<th class="text-right py-2 text-xs font-medium text-gray-500">Signals</th>
<th class="text-right py-2 text-xs font-medium text-gray-500">Eval</th>
<th class="text-right py-2 text-xs font-medium text-gray-500">Deployed</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-50">
{forEach deploys (renderDeployRow decisions signals evals)}
</tbody>
</table>
|]
renderRecurrenceSection :: [(Id Widget, Int)] -> [Widget] -> Html
renderRecurrenceSection [] _ = [hsx|<p class="text-sm text-gray-400">No recurring widgets detected.</p>|]
renderRecurrenceSection leaderboard widgets = [hsx|
<table class="w-full text-sm">
<thead class="border-b border-gray-100">
<tr>
<th class="text-left py-2 text-xs font-medium text-gray-500">Widget</th>
<th class="text-right py-2 text-xs font-medium text-gray-500">Cycles</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-50">
{forEach leaderboard (renderRecurrenceRow widgets)}
</tbody>
</table>
|]
noEvalBadge :: Html
noEvalBadge = [hsx|<span class="text-gray-400 text-xs">—</span>|]
noWidgetSpan :: Html
noWidgetSpan = [hsx|<span class="text-gray-500">—</span>|]
renderSignalDot :: OutcomeSignal -> Html
renderSignalDot s = [hsx|<span class={signalDot s.signalType}></span>|]
outcomeClass :: Text -> Text
outcomeClass "accepted" = "bg-green-100 text-green-800"
outcomeClass "rejected" = "bg-red-100 text-red-800"

14
Web/View/Hubs/BottleneckDashboard.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Time.Clock (diffUTCTime, getCurrentTime)
data BottleneckDashboardView = BottleneckDashboardView
@@ -20,11 +21,11 @@ instance View BottleneckDashboardView where
<p class="text-sm text-gray-500">{hub.name}</p>
</div>
<div class="flex gap-2">
<a href={DetectBottlenecksAction { hubId = hub.id }}
<a href={DetectBottlenecksAction (hub.id)}
class="text-sm bg-indigo-600 text-white px-3 py-1.5 rounded hover:bg-indigo-700">
Detect
</a>
<a href={ShowHubAction { hubId = hub.id }}
<a href={ShowHubAction (hub.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
← Hub
</a>
@@ -33,9 +34,7 @@ instance View BottleneckDashboardView where
{forEach stages renderStageSection}
{if null bottlenecks
then [hsx|<p class="text-sm text-gray-400 mt-4">No active bottlenecks detected.</p>|]
else mempty}
{if null bottlenecks then noBottlenecksMsg else mempty}
|]
where
stages = ["candidate", "requirement", "decision", "observation"] :: [Text]
@@ -83,12 +82,15 @@ instance View BottleneckDashboardView where
</span>
</td>
<td class="px-3 py-2 text-right">
<a href={ResolveBottleneckAction { bottleneckRecordId = b.id }}
<a href={ResolveBottleneckAction (b.id)}
class="text-xs text-indigo-600 hover:underline">Resolve</a>
</td>
</tr>
|]
noBottlenecksMsg :: Html
noBottlenecksMsg = [hsx|<p class="text-sm text-gray-400 mt-4">No active bottlenecks detected.</p>|]
severityBadge :: Text -> Text
severityBadge s = case s of
"critical" -> "bg-red-100 text-red-800"

3
Web/View/Hubs/Edit.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data EditView = EditView { hub :: !Hub }
@@ -13,7 +14,7 @@ instance View EditView where
<div class="flex items-center gap-2 text-sm text-gray-500 mb-4">
<a href={HubsAction} class="hover:text-gray-700">Hubs</a>
<span>/</span>
<a href={ShowHubAction { hubId = hub.id }} class="hover:text-gray-700">{hub.name}</a>
<a href={ShowHubAction (hub.id)} class="hover:text-gray-700">{hub.name}</a>
<span>/</span>
<span>Edit</span>
</div>

31
Web/View/Hubs/FrictionHeatmap.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Application.Helper.FrictionScore (scoreBand)
data FrictionHeatmapView = FrictionHeatmapView
@@ -20,11 +21,11 @@ instance View FrictionHeatmapView where
<p class="text-sm text-gray-500">{hub.name}</p>
</div>
<div class="flex gap-2">
<a href={RecomputeFrictionAction { hubId = hub.id }}
<a href={RecomputeFrictionAction (hub.id)}
class="text-sm bg-indigo-600 text-white px-3 py-1.5 rounded hover:bg-indigo-700">
Recompute
</a>
<a href={ShowHubAction { hubId = hub.id }}
<a href={ShowHubAction (hub.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
← Hub
</a>
@@ -38,18 +39,20 @@ instance View FrictionHeatmapView where
<span><span class="inline-block w-3 h-3 rounded bg-red-100 mr-1"></span>Critical (60+)</span>
</div>
{if null widgets
then [hsx|<p class="text-sm text-gray-400">No widgets in this hub.</p>|]
else [hsx|
<div class="grid grid-cols-3 gap-3">
{forEach widgets renderWidgetCard}
</div>
|]}
{renderHeatmapGrid widgets}
|]
where
scoreFor w = maybe 0 (.score) (find (\fs -> fs.widgetId == w.id) frictionScores)
hasScore w = any (\fs -> fs.widgetId == w.id) frictionScores
renderHeatmapGrid :: [Widget] -> Html
renderHeatmapGrid [] = [hsx|<p class="text-sm text-gray-400">No widgets in this hub.</p>|]
renderHeatmapGrid ws = [hsx|
<div class="grid grid-cols-3 gap-3">
{forEach ws renderWidgetCard}
</div>
|]
renderWidgetCard :: Widget -> Html
renderWidgetCard w =
let s = scoreFor w
@@ -57,12 +60,14 @@ instance View FrictionHeatmapView where
in [hsx|
<div class={"rounded-lg border p-4 " <> band}>
<div class="flex items-start justify-between">
<a href={ShowWidgetAction { widgetId = w.id }}
<a href={ShowWidgetAction (w.id)}
class="font-medium text-sm hover:underline">{w.name}</a>
{if hasScore w
then [hsx|<span class="text-lg font-bold">{show s}</span>|]
else [hsx|<span class="text-xs text-gray-400">–</span>|]}
{renderScoreBadge (hasScore w) s}
</div>
<p class="text-xs mt-1 opacity-70">{w.widgetType}</p>
</div>
|]
renderScoreBadge :: Bool -> Int -> Html
renderScoreBadge True s = [hsx|<span class="text-lg font-bold">{show s}</span>|]
renderScoreBadge False _ = [hsx|<span class="text-xs text-gray-400">–</span>|]

78
Web/View/Hubs/GovernanceDashboard.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data GovernanceDashboardView = GovernanceDashboardView
{ hub :: !Hub
@@ -23,22 +24,22 @@ instance View GovernanceDashboardView where
<div class="flex items-center gap-2 text-sm text-gray-500 mb-1">
<a href={HubsAction} class="hover:text-gray-700">Hubs</a>
<span>/</span>
<a href={ShowHubAction { hubId = hub.id }} class="hover:text-gray-700">{hub.name}</a>
<a href={ShowHubAction (hub.id)} class="hover:text-gray-700">{hub.name}</a>
<span>/</span>
<span>Governance</span>
</div>
<h1 class="text-2xl font-semibold">Governance Dashboard — {hub.name}</h1>
</div>
<div class="flex gap-2">
<a href={TriageDashboardAction { hubId = hub.id }}
<a href={TriageDashboardAction (hub.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Triage Dashboard
</a>
<a href={AntifragilityDashboardAction { hubId = hub.id }}
<a href={AntifragilityDashboardAction (hub.id)}
class="text-sm border border-green-300 text-green-700 px-3 py-1.5 rounded hover:bg-green-50">
Antifragility
</a>
<a href={ShowHubAction { hubId = hub.id }}
<a href={ShowHubAction (hub.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Hub Overview
</a>
@@ -54,14 +55,7 @@ instance View GovernanceDashboardView where
</div>
</div>
{if null regressionWidgetIds then mempty else [hsx|
<div class="bg-red-50 border border-red-200 rounded-lg px-6 py-4 mb-6">
<h2 class="text-sm font-semibold text-red-700 mb-2">⚠ Regressed Widgets</h2>
<div class="flex flex-wrap gap-2">
{forEach regressedWidgets renderRegressedBadge}
</div>
</div>
|]}
{if null regressionWidgetIds then mempty else renderGovRegressionAlerts regressedWidgets}
<!-- Open requirements awaiting decision -->
<div class="bg-white rounded-lg border border-gray-200 px-6 py-5 mb-6">
@@ -71,31 +65,13 @@ instance View GovernanceDashboardView where
({show (length awaitingDecision)} pending)
</span>
</h2>
{if null awaitingDecision
then [hsx|<p class="text-sm text-gray-400">All requirements have linked decisions.</p>|]
else forEach awaitingDecision renderAwaitingReq}
{renderAwaitingSection awaitingDecision}
</div>
<!-- Recent decisions -->
<div class="bg-white rounded-lg border border-gray-200 px-6 py-5 mb-6">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Recent Decisions</h2>
{if null recentDecisions
then [hsx|<p class="text-sm text-gray-400">No decisions recorded yet.</p>|]
else [hsx|
<table class="w-full text-sm">
<thead class="border-b border-gray-100">
<tr>
<th class="text-left py-2 text-xs font-medium text-gray-500">Title</th>
<th class="text-left py-2 text-xs font-medium text-gray-500">Outcome</th>
<th class="text-left py-2 text-xs font-medium text-gray-500">Source Widget</th>
<th class="text-left py-2 text-xs font-medium text-gray-500">Decided At</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-50">
{forEach recentDecisions (renderDecisionRow allRequirements allCandidates widgets)}
</tbody>
</table>
|]}
{renderRecentDecisionsSection recentDecisions allRequirements allCandidates widgets}
</div>
<!-- Traceability coverage per widget -->
@@ -150,7 +126,7 @@ isAwaitingDecision decisions req =
renderAwaitingReq :: Requirement -> Html
renderAwaitingReq req = [hsx|
<div class="flex items-center justify-between py-2 border-b border-gray-50 last:border-0">
<a href={ShowRequirementAction { requirementId = req.id }}
<a href={ShowRequirementAction (req.id)}
class="text-sm text-indigo-600 hover:text-indigo-800">{req.title}</a>
<span class="text-xs text-gray-400">{show req.createdAt}</span>
</div>
@@ -160,7 +136,7 @@ renderDecisionRow :: [Requirement] -> [RequirementCandidate] -> [Widget] -> Deci
renderDecisionRow reqs candidates widgets dr = [hsx|
<tr>
<td class="py-2 pr-4">
<a href={ShowDecisionRecordAction { decisionRecordId = dr.id }}
<a href={ShowDecisionRecordAction (dr.id)}
class="text-indigo-600 hover:text-indigo-800">{dr.title}</a>
</td>
<td class="py-2 pr-4">
@@ -213,7 +189,7 @@ renderCoverageRow annotations candidates requirements decisions w = [hsx|
renderRegressedBadge :: Widget -> Html
renderRegressedBadge w = [hsx|
<a href={ShowWidgetAction { widgetId = w.id }}
<a href={ShowWidgetAction (w.id)}
class="text-xs bg-red-100 text-red-800 border border-red-300 rounded px-2 py-1 hover:bg-red-200">
{w.name}
</a>
@@ -223,6 +199,38 @@ coverageMark :: Bool -> Html
coverageMark True = [hsx|<span class="text-green-600 font-bold">✓</span>|]
coverageMark False = [hsx|<span class="text-gray-300">✗</span>|]
renderGovRegressionAlerts :: [Widget] -> Html
renderGovRegressionAlerts ws = [hsx|
<div class="bg-red-50 border border-red-200 rounded-lg px-6 py-4 mb-6">
<h2 class="text-sm font-semibold text-red-700 mb-3">Regression Alerts</h2>
<div class="flex flex-wrap gap-2">
{forEach ws renderRegressedBadge}
</div>
</div>
|]
renderAwaitingSection :: [Requirement] -> Html
renderAwaitingSection [] = [hsx|<p class="text-sm text-gray-400">All requirements have linked decisions.</p>|]
renderAwaitingSection reqs = [hsx|{forEach reqs renderAwaitingReq}|]
renderRecentDecisionsSection :: [DecisionRecord] -> [Requirement] -> [RequirementCandidate] -> [Widget] -> Html
renderRecentDecisionsSection [] _ _ _ = [hsx|<p class="text-sm text-gray-400">No decisions recorded yet.</p>|]
renderRecentDecisionsSection decisions reqs candidates ws = [hsx|
<table class="w-full text-sm">
<thead class="border-b border-gray-100">
<tr>
<th class="text-left py-2 text-xs font-medium text-gray-500">Title</th>
<th class="text-left py-2 text-xs font-medium text-gray-500">Outcome</th>
<th class="text-left py-2 text-xs font-medium text-gray-500">Source Widget</th>
<th class="text-left py-2 text-xs font-medium text-gray-500">Decided At</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-50">
{forEach decisions (renderDecisionRow reqs candidates ws)}
</tbody>
</table>
|]
outcomeClass :: Text -> Text
outcomeClass "accepted" = "bg-green-100 text-green-800"
outcomeClass "rejected" = "bg-red-100 text-red-800"

85
Web/View/Hubs/HubHealthHistory.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Application.Helper.HubHealth (healthScoreBadge)
data HubHealthHistoryView = HubHealthHistoryView
@@ -19,57 +20,63 @@ instance View HubHealthHistoryView where
<p class="text-sm text-gray-500">{hub.name}</p>
</div>
<div class="flex gap-2">
<a href={SnapshotHubHealthAction { hubId = hub.id }}
<a href={SnapshotHubHealthAction (hub.id)}
class="text-sm bg-indigo-600 text-white px-3 py-1.5 rounded hover:bg-indigo-700">
Take Snapshot
</a>
<a href={ShowHubAction { hubId = hub.id }}
<a href={ShowHubAction (hub.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
← Hub
</a>
</div>
</div>
{case snapshots of
[] -> [hsx|<p class="text-sm text-gray-400">No snapshots yet. Take the first one.</p>|]
(latest : _) -> [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-6 flex items-center gap-6">
<div>
<p class="text-xs text-gray-500 mb-1">Current Health Score</p>
<span class={"text-3xl font-bold px-3 py-1 rounded " <> healthScoreBadge latest.healthScore}>
{show latest.healthScore}
</span>
</div>
<div class="text-sm text-gray-600 space-y-1">
<div>Open candidates: <strong>{show latest.openCandidates}</strong></div>
<div>Regressed widgets: <strong>{show latest.regressedWidgets}</strong></div>
<div>Stale decisions: <strong>{show latest.staleDecisions}</strong></div>
<div>Active bottlenecks: <strong>{show latest.activeBottlenecks}</strong></div>
</div>
</div>
|]}
{renderLatestPanel snapshots}
{if null snapshots then mempty else [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Score</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Open Cand.</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Regressed</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Stale Dec.</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Bottlenecks</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Taken At</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach snapshots renderRow}
</tbody>
</table>
</div>
|]}
{renderSnapshotsTable snapshots}
|]
renderLatestPanel :: [HubHealthSnapshot] -> Html
renderLatestPanel [] = [hsx|<p class="text-sm text-gray-400">No snapshots yet. Take the first one.</p>|]
renderLatestPanel (latest : _) = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-6 flex items-center gap-6">
<div>
<p class="text-xs text-gray-500 mb-1">Current Health Score</p>
<span class={"text-3xl font-bold px-3 py-1 rounded " <> healthScoreBadge latest.healthScore}>
{show latest.healthScore}
</span>
</div>
<div class="text-sm text-gray-600 space-y-1">
<div>Open candidates: <strong>{show latest.openCandidates}</strong></div>
<div>Regressed widgets: <strong>{show latest.regressedWidgets}</strong></div>
<div>Stale decisions: <strong>{show latest.staleDecisions}</strong></div>
<div>Active bottlenecks: <strong>{show latest.activeBottlenecks}</strong></div>
</div>
</div>
|]
renderSnapshotsTable :: [HubHealthSnapshot] -> Html
renderSnapshotsTable [] = mempty
renderSnapshotsTable snaps = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Score</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Open Cand.</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Regressed</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Stale Dec.</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Bottlenecks</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Taken At</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach snaps renderRow}
</tbody>
</table>
</div>
|]
renderRow :: HubHealthSnapshot -> Html
renderRow s = [hsx|
<tr class="hover:bg-gray-50">

7
Web/View/Hubs/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data IndexView = IndexView { hubs :: ![Hub] }
@@ -44,7 +45,7 @@ renderHub :: Hub -> Html
renderHub hub = [hsx|
<tr class="border-b border-gray-100 hover:bg-gray-50">
<td class="px-4 py-3">
<a href={ShowHubAction { hubId = hub.id }}
<a href={ShowHubAction (hub.id)}
class="font-medium text-indigo-600 hover:text-indigo-800">
{hub.name}
</a>
@@ -53,9 +54,9 @@ renderHub hub = [hsx|
<td class="px-4 py-3 text-gray-500">{hub.domain}</td>
<td class="px-4 py-3">{kindBadge hub.hubKind}</td>
<td class="px-4 py-3 text-right">
<a href={EditHubAction { hubId = hub.id }}
<a href={EditHubAction (hub.id)}
class="text-gray-500 hover:text-gray-700 text-xs mr-3">Edit</a>
<a href={DeleteHubAction { hubId = hub.id }}
<a href={DeleteHubAction (hub.id)}
class="text-red-500 hover:text-red-700 text-xs"
data-confirm="Delete this hub?">Delete</a>
</td>

1
Web/View/Hubs/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView { hub :: !Hub }

129
Web/View/Hubs/OperationalReviewBoard.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Application.Helper.HubHealth (healthScoreBadge)
import Application.Helper.FrictionScore (scoreBand)
import Web.View.Hubs.BottleneckDashboard (severityBadge)
@@ -26,68 +27,25 @@ instance View OperationalReviewBoardView where
<!-- Panel 1: Hub health matrix -->
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-4">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Hub Health Matrix</h2>
{if null hubs
then [hsx|<p class="text-sm text-gray-400">No hubs registered.</p>|]
else [hsx|
<table class="w-full text-sm">
<thead class="bg-gray-50">
<tr>
<th class="text-left px-3 py-2 font-medium text-gray-600">Hub</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Health</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Snapshot</th>
<th class="px-3 py-2"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach hubs renderHubRow}
</tbody>
</table>
|]}
{renderHubHealthTable hubs}
</div>
<!-- Panel 2: Top friction widgets -->
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-4">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Top Friction Widgets</h2>
{if null topFrictionScores
then [hsx|<p class="text-sm text-gray-400">No friction scores computed yet.</p>|]
else [hsx|
<table class="w-full text-sm">
<thead class="bg-gray-50">
<tr>
<th class="text-left px-3 py-2 font-medium text-gray-600">Widget</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Score</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Type</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach (zip topFrictionScores topWidgets) renderFrictionRow}
</tbody>
</table>
|]}
{renderFrictionTable topFrictionScores topWidgets}
</div>
<!-- Panel 3: Active bottlenecks by stage -->
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-4">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Active Bottlenecks by Stage</h2>
{if null bottlenecks
then [hsx|<p class="text-sm text-gray-400">No active bottlenecks.</p>|]
else [hsx|
<div class="grid grid-cols-4 gap-3">
{forEach stages renderBottleneckStage}
</div>
|]}
{renderBottlenecksPanel bottlenecks}
</div>
<!-- Panel 4: Open cross-hub propagations -->
<div class="bg-white rounded-lg border border-gray-200 p-5">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Open Cross-Hub Propagations</h2>
{if null openPropagations
then [hsx|<p class="text-sm text-gray-400">No open propagation events.</p>|]
else [hsx|
<div class="space-y-2">
{forEach openPropagations renderPropagationRow}
</div>
|]}
{renderPropagationsPanel openPropagations}
</div>
|]
where
@@ -108,23 +66,17 @@ instance View OperationalReviewBoardView where
in [hsx|
<tr class="hover:bg-gray-50">
<td class="px-3 py-2">
<a href={ShowHubAction { hubId = h.id }}
<a href={ShowHubAction (h.id)}
class="text-indigo-600 hover:underline">{h.name}</a>
</td>
<td class="px-3 py-2">
{case mSnap of
Nothing -> [hsx|<span class="text-xs text-gray-400">–</span>|]
Just s -> [hsx|
<span class={"px-2 py-0.5 rounded text-xs font-semibold " <> healthScoreBadge s.healthScore}>
{show s.healthScore}
</span>
|]}
{renderHealthScore mSnap}
</td>
<td class="px-3 py-2 text-xs text-gray-400">
{maybe "never" (\s -> show s.computedAt) mSnap}
</td>
<td class="px-3 py-2 text-right">
<a href={HubHealthHistoryAction { hubId = h.id }}
<a href={HubHealthHistoryAction (h.id)}
class="text-xs text-indigo-600 hover:underline">History</a>
</td>
</tr>
@@ -134,7 +86,7 @@ instance View OperationalReviewBoardView where
renderFrictionRow (fs, w) = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-3 py-2">
<a href={ShowWidgetAction { widgetId = w.id }}
<a href={ShowWidgetAction (w.id)}
class="text-indigo-600 hover:underline">{w.name}</a>
</td>
<td class="px-3 py-2">
@@ -170,10 +122,69 @@ instance View OperationalReviewBoardView where
<p class="text-xs text-gray-400 mt-0.5">{show p.detectedAt}</p>
</div>
<div class="flex gap-2 ml-4">
<a href={AcknowledgePropagationAction { crossHubPropagationId = p.id }}
<a href={AcknowledgePropagationAction (p.id)}
class="text-xs text-yellow-600 hover:underline whitespace-nowrap">Acknowledge</a>
<a href={ResolvePropagationAction { crossHubPropagationId = p.id }}
<a href={ResolvePropagationAction (p.id)}
class="text-xs text-green-600 hover:underline">Resolve</a>
</div>
</div>
|]
renderHubHealthTable :: [Hub] -> Html
renderHubHealthTable [] = [hsx|<p class="text-sm text-gray-400">No hubs registered.</p>|]
renderHubHealthTable hs = [hsx|
<table class="w-full text-sm">
<thead class="bg-gray-50">
<tr>
<th class="text-left px-3 py-2 font-medium text-gray-600">Hub</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Health</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Snapshot</th>
<th class="px-3 py-2"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach hs renderHubRow}
</tbody>
</table>
|]
renderFrictionTable :: [FrictionScore] -> [Widget] -> Html
renderFrictionTable [] _ = [hsx|<p class="text-sm text-gray-400">No friction scores computed yet.</p>|]
renderFrictionTable scores ws = [hsx|
<table class="w-full text-sm">
<thead class="bg-gray-50">
<tr>
<th class="text-left px-3 py-2 font-medium text-gray-600">Widget</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Score</th>
<th class="text-left px-3 py-2 font-medium text-gray-600">Type</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach (zip scores ws) renderFrictionRow}
</tbody>
</table>
|]
renderBottlenecksPanel :: [BottleneckRecord] -> Html
renderBottlenecksPanel [] = [hsx|<p class="text-sm text-gray-400">No active bottlenecks.</p>|]
renderBottlenecksPanel _ = [hsx|
<div class="grid grid-cols-4 gap-3">
{forEach stages renderBottleneckStage}
</div>
|]
renderPropagationsPanel :: [CrossHubPropagation] -> Html
renderPropagationsPanel [] = [hsx|<p class="text-sm text-gray-400">No open propagation events.</p>|]
renderPropagationsPanel ps = [hsx|
<div class="space-y-2">
{forEach ps renderPropagationRow}
</div>
|]
renderHealthScore :: Maybe HubHealthSnapshot -> Html
renderHealthScore Nothing = [hsx|<span class="text-xs text-gray-400">–</span>|]
renderHealthScore (Just s) = [hsx|
<span class={"px-2 py-0.5 rounded text-xs font-semibold " <> healthScoreBadge s.healthScore}>
{show s.healthScore}
</span>
|]

33
Web/View/Hubs/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data ShowView = ShowView
{ hub :: !Hub
@@ -33,39 +34,39 @@ instance View ShowView where
</p>
</div>
<div class="flex gap-2">
<a href={TriageDashboardAction { hubId = hub.id }}
<a href={TriageDashboardAction (hub.id)}
class="text-sm border border-indigo-300 text-indigo-700 px-3 py-1.5 rounded hover:bg-indigo-50">
Triage Dashboard
</a>
<a href={GovernanceDashboardAction { hubId = hub.id }}
<a href={GovernanceDashboardAction (hub.id)}
class="text-sm border border-purple-300 text-purple-700 px-3 py-1.5 rounded hover:bg-purple-50">
Governance Dashboard
</a>
<a href={AntifragilityDashboardAction { hubId = hub.id }}
<a href={AntifragilityDashboardAction (hub.id)}
class="text-sm border border-green-300 text-green-700 px-3 py-1.5 rounded hover:bg-green-50">
Antifragility
</a>
<a href={AgentAuditDashboardAction { hubId = hub.id }}
<a href={AgentAuditDashboardAction (hub.id)}
class="text-sm border border-purple-300 text-purple-700 px-3 py-1.5 rounded hover:bg-purple-50">
Agent Audit
</a>
<a href={AdapterCompatibilityDashboardAction { hubId = hub.id }}
<a href={AdapterCompatibilityDashboardAction (hub.id)}
class="text-sm border border-teal-300 text-teal-700 px-3 py-1.5 rounded hover:bg-teal-50">
Adapters
</a>
<a href={FrictionHeatmapAction { hubId = hub.id }}
<a href={FrictionHeatmapAction (hub.id)}
class="text-sm border border-orange-300 text-orange-700 px-3 py-1.5 rounded hover:bg-orange-50">
Friction
</a>
<a href={BottleneckDashboardAction { hubId = hub.id }}
<a href={BottleneckDashboardAction (hub.id)}
class="text-sm border border-red-300 text-red-700 px-3 py-1.5 rounded hover:bg-red-50">
Bottlenecks
</a>
<a href={HubHealthHistoryAction { hubId = hub.id }}
<a href={HubHealthHistoryAction (hub.id)}
class="text-sm border border-green-300 text-green-700 px-3 py-1.5 rounded hover:bg-green-50">
Health
</a>
<a href={EditHubAction { hubId = hub.id }}
<a href={EditHubAction (hub.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Edit
</a>
@@ -146,7 +147,7 @@ renderWidgetRow :: Widget -> Html
renderWidgetRow w = [hsx|
<tr class="border-b border-gray-100 hover:bg-gray-50">
<td class="px-4 py-3">
<a href={ShowWidgetAction { widgetId = w.id }}
<a href={ShowWidgetAction (w.id)}
class="font-medium text-indigo-600 hover:text-indigo-800">
{w.name}
</a>
@@ -202,12 +203,12 @@ renderManifestSection (Just m) _ = [hsx|
<div class="flex items-center gap-2">
{manifestStatusBadge m.status}
<span class="text-sm text-gray-600">v{m.manifestVersion}</span>
{forEach (maybeText m.capabilityDescription) (\d -> [hsx|<span class="text-sm text-gray-500">— {d}</span>|])}
{maybe mempty renderCapabilityDesc m.capabilityDescription}
</div>
<a href={ShowHubCapabilityManifestAction { hubCapabilityManifestId = m.id }}
<a href={ShowHubCapabilityManifestAction (m.id)}
class="text-sm text-indigo-600 hover:text-indigo-800">View manifest →</a>
</div>
{forEach (maybeText m.contact) (\c -> [hsx|<p class="text-xs text-gray-400">Contact: {c}</p>|])}
{maybe mempty renderManifestContactLine m.contact}
</div>
|]
@@ -225,3 +226,9 @@ kindBadge _ = [hsx|<span class="px-2 py-0.5 rounded text-xs bg-blue-10
maybeText :: Maybe Text -> [Text]
maybeText Nothing = []
maybeText (Just t) = [t]
renderCapabilityDesc :: Text -> Html
renderCapabilityDesc d = [hsx|<span class="text-sm text-gray-500">— {d}</span>|]
renderManifestContactLine :: Text -> Html
renderManifestContactLine c = [hsx|<p class="text-xs text-gray-400">Contact: {c}</p>|]

39
Web/View/Hubs/TriageDashboard.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data TriageDashboardView = TriageDashboardView
{ hub :: !Hub
@@ -20,7 +21,7 @@ instance View TriageDashboardView where
<div class="mb-6 flex items-center gap-2 text-sm text-gray-500">
<a href={HubsAction} class="hover:text-gray-700">Hubs</a>
<span>/</span>
<a href={ShowHubAction { hubId = hub.id }} class="hover:text-gray-700">{hub.name}</a>
<a href={ShowHubAction (hub.id)} class="hover:text-gray-700">{hub.name}</a>
<span>/</span>
<span>Triage Dashboard</span>
</div>
@@ -46,25 +47,13 @@ instance View TriageDashboardView where
<!-- Triage queue -->
<section>
<h2 class="text-lg font-medium mb-3">Triage Queue (Open)</h2>
{if null triageQueue
then [hsx|<p class="text-sm text-gray-400">Queue empty.</p>|]
else [hsx|
<div class="space-y-2">
{forEach triageQueue (renderQueueItem widgets)}
</div>
|]}
{renderTriageQueue triageQueue widgets}
</section>
<!-- Recent escalations -->
<section>
<h2 class="text-lg font-medium mb-3">Recent Escalations</h2>
{if null recentEscalations
then [hsx|<p class="text-sm text-gray-400">No escalations yet.</p>|]
else [hsx|
<div class="space-y-2">
{forEach recentEscalations (renderEscalationItem widgets)}
</div>
|]}
{renderEscalationsSection recentEscalations widgets}
</section>
</div>
@@ -85,6 +74,22 @@ renderKpi label status candidates colorClass =
</div>
|]
renderTriageQueue :: [RequirementCandidate] -> [Widget] -> Html
renderTriageQueue [] _ = [hsx|<p class="text-sm text-gray-400">Queue empty.</p>|]
renderTriageQueue items ws = [hsx|
<div class="space-y-2">
{forEach items (renderQueueItem ws)}
</div>
|]
renderEscalationsSection :: [RequirementCandidate] -> [Widget] -> Html
renderEscalationsSection [] _ = [hsx|<p class="text-sm text-gray-400">No escalations yet.</p>|]
renderEscalationsSection items ws = [hsx|
<div class="space-y-2">
{forEach items (renderEscalationItem ws)}
</div>
|]
renderQueueItem :: [Widget] -> RequirementCandidate -> Html
renderQueueItem widgets c =
let mWidget = find (\w -> w.id == c.sourceWidgetId) widgets
@@ -92,7 +97,7 @@ renderQueueItem widgets c =
in [hsx|
<div class="bg-white rounded border border-gray-200 px-4 py-3">
<div class="flex items-start justify-between gap-2">
<a href={ShowRequirementCandidateAction { requirementCandidateId = c.id }}
<a href={ShowRequirementCandidateAction (c.id)}
class="text-sm font-medium text-indigo-600 hover:text-indigo-800 leading-snug">
{c.title}
</a>
@@ -115,7 +120,7 @@ renderEscalationItem widgets c =
<span class={statusClass c.status <> " text-xs px-2 py-0.5 rounded"}>{c.status}</span>
<span class="text-xs text-gray-500">{maybe "—" (.name) mWidget}</span>
</div>
<a href={ShowRequirementCandidateAction { requirementCandidateId = c.id }}
<a href={ShowRequirementCandidateAction (c.id)}
class="text-sm text-indigo-600 hover:text-indigo-800">{c.title}</a>
</div>
|]

45
Web/View/InstitutionalKnowledge/Index.hs
View File

@@ -1,6 +1,6 @@
module Web.View.InstitutionalKnowledge.Index where
import Web.View.Prelude
import IHP.ViewPrelude
data IndexView = IndexView
{ entries :: ![InstitutionalKnowledgeEntry]
@@ -27,7 +27,7 @@ instance View IndexView where
<label class="block text-sm font-medium text-gray-700 mb-1">Hub</label>
<select name="hubId" class="border border-gray-300 rounded-md px-3 py-2 text-sm">
<option value="">All hubs</option>
{forM_ hubs \h -> [hsx|<option value={show h.id}>{h.name}</option>|]}
{forEach hubs renderHubOption}
</select>
</div>
<button type="submit"
@@ -36,23 +36,28 @@ instance View IndexView where
</button>
</form>
{if null entries
then [hsx|<p class="text-gray-500 text-sm">No entries found.</p>|]
else [hsx|
<div class="space-y-4">
{forM_ entries renderEntry}
</div>
|]}
{renderEntriesSection entries}
</div>
|]
where
renderEntry e = [hsx|
<div class="bg-white shadow rounded-lg p-5">
<div class="flex justify-between items-start">
<p class="text-sm text-gray-800 leading-relaxed flex-1 mr-4">{e.summary}</p>
<a href={ShowInstitutionalKnowledgeAction { knowledgeEntryId = e.id }}
class="text-sm text-blue-600 hover:underline whitespace-nowrap">View</a>
</div>
<p class="text-xs text-gray-400 mt-2">{show e.createdAt}</p>
</div>
|]
renderHubOption :: Hub -> Html
renderHubOption h = [hsx|<option value={show h.id}>{h.name}</option>|]
renderEntriesSection :: [InstitutionalKnowledgeEntry] -> Html
renderEntriesSection [] = [hsx|<p class="text-gray-500 text-sm">No entries found.</p>|]
renderEntriesSection entries = [hsx|
<div class="space-y-4">
{forEach entries renderEntry}
</div>
|]
renderEntry :: InstitutionalKnowledgeEntry -> Html
renderEntry e = [hsx|
<div class="bg-white shadow rounded-lg p-5">
<div class="flex justify-between items-start">
<p class="text-sm text-gray-800 leading-relaxed flex-1 mr-4">{e.summary}</p>
<a href={ShowInstitutionalKnowledgeAction (e.id)}
class="text-sm text-blue-600 hover:underline whitespace-nowrap">View</a>
</div>
<p class="text-xs text-gray-400 mt-2">{show e.createdAt}</p>
</div>
|]

27
Web/View/InstitutionalKnowledge/Show.hs
View File

@@ -1,6 +1,6 @@
module Web.View.InstitutionalKnowledge.Show where
import Web.View.Prelude
import IHP.ViewPrelude
data ShowView = ShowView
{ entry :: !InstitutionalKnowledgeEntry
@@ -22,18 +22,19 @@ instance View ShowView where
<span class="text-xs text-gray-400">{show entry.createdAt}</span>
</div>
<p class="text-gray-800 leading-relaxed text-sm">{entry.summary}</p>
{case mDecision of
Nothing -> mempty
Just dr -> [hsx|
<div class="mt-5 border-t pt-4">
<p class="text-xs font-medium text-gray-500 uppercase mb-2">Source Decision</p>
<a href={ShowDecisionRecordAction { decisionRecordId = dr.id }}
class="text-sm text-blue-600 hover:underline">
{dr.title}
</a>
<span class="ml-2 text-xs text-gray-500">({dr.outcome})</span>
</div>
|]}
{maybe mempty renderSourceDecision mDecision}
</div>
</div>
|]
renderSourceDecision :: DecisionRecord -> Html
renderSourceDecision dr = [hsx|
<div class="mt-5 border-t pt-4">
<p class="text-xs font-medium text-gray-500 uppercase mb-2">Source Decision</p>
<a href={ShowDecisionRecordAction (dr.id)}
class="text-sm text-blue-600 hover:underline">
{dr.title}
</a>
<span class="ml-2 text-xs text-gray-500">({dr.outcome})</span>
</div>
|]

10
Web/View/InteractionReportingContracts/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Application.Helper.View (adapterStatusBadge)
data IndexView = IndexView
@@ -25,11 +26,12 @@ instance View IndexView where
</a>
</div>
{if null contracts
then [hsx|<p class="text-sm text-gray-400">No contracts found.</p>|]
else renderTable contracts}
{if null contracts then noContractsMsg else renderTable contracts}
|]
noContractsMsg :: Html
noContractsMsg = [hsx|<p class="text-sm text-gray-400">No contracts found.</p>|]
renderTable :: [InteractionReportingContract] -> Html
renderTable contracts = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
@@ -54,7 +56,7 @@ renderRow :: InteractionReportingContract -> Html
renderRow c = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3">
<a href={ShowInteractionReportingContractAction { interactionReportingContractId = c.id }}
<a href={ShowInteractionReportingContractAction (c.id)}
class="font-mono text-indigo-600 hover:underline">v{c.contractVersion}</a>
</td>
<td class="px-4 py-3 font-mono text-xs text-gray-700">{c.endpointPath}</td>

8
Web/View/InteractionReportingContracts/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Application.Helper.View (adapterStatusBadge)
data ShowView = ShowView
@@ -28,9 +29,7 @@ instance View ShowView where
{maturityBadge contract.maturity}
</div>
{forEach (contractDescription contract) (\d -> [hsx|
<p class="text-sm text-gray-600 mb-6">{d}</p>
|])}
{forEach (contractDescription contract) renderContractDescription}
<div class="grid grid-cols-1 gap-4">
<div class="bg-white rounded-lg border border-gray-200 p-5">
@@ -71,6 +70,9 @@ instance View ShowView where
</div>
|]
renderContractDescription :: Text -> Html
renderContractDescription d = [hsx|<p class="text-sm text-gray-600 mb-6">{d}</p>|]
contractDescription :: InteractionReportingContract -> [Text]
contractDescription c = case c.description of
Just d -> [d]

196
Web/View/LearningDashboard/Show.hs
View File

@@ -1,6 +1,6 @@
module Web.View.LearningDashboard.Show where
import Web.View.Prelude
import IHP.ViewPrelude
import Data.Time (diffUTCTime, getCurrentTime, nominalDay)
data ShowView = ShowView
@@ -21,25 +21,13 @@ instance View ShowView where
{-- Panel 1: Top annotation predictors --}
<div class="bg-white shadow rounded-lg p-5">
<h2 class="text-base font-semibold text-gray-800 mb-4">Top Annotation Predictors</h2>
{if null topCorrelations
then [hsx|<p class="text-sm text-gray-400">No data — run correlation analysis per hub.</p>|]
else [hsx|
<div class="space-y-2">
{forM_ topCorrelations renderCorrelation}
</div>
|]}
{renderCorrelationsSection topCorrelations}
</div>
{-- Panel 2: Pattern performance ranking --}
<div class="bg-white shadow rounded-lg p-5">
<h2 class="text-base font-semibold text-gray-800 mb-4">Pattern Performance Ranking</h2>
{if null patternRankings
then [hsx|<p class="text-sm text-gray-400">No data — run pattern performance per hub.</p>|]
else [hsx|
<div class="space-y-2">
{forM_ patternRankings renderPatternRank}
</div>
|]}
{renderPatternRankingsSection patternRankings}
</div>
</div>
@@ -57,95 +45,121 @@ instance View ShowView where
{-- Panel 4: Recent learning insights --}
<div class="bg-white shadow rounded-lg p-5">
<h2 class="text-base font-semibold text-gray-800 mb-4">Recent Insights</h2>
{if null recentInsights
then [hsx|<p class="text-sm text-gray-400">No insights yet.</p>|]
else [hsx|
<div class="space-y-3">
{forM_ recentInsights renderInsight}
</div>
|]}
{renderInsightsSection recentInsights}
</div>
{-- Panel 5: Knowledge base highlights --}
<div class="bg-white shadow rounded-lg p-5">
<h2 class="text-base font-semibold text-gray-800 mb-4">Knowledge Highlights</h2>
{if null knowledgeHighlights
then [hsx|<p class="text-sm text-gray-400">No entries yet — distil a decision.</p>|]
else [hsx|
<div class="space-y-3">
{forM_ knowledgeHighlights renderKnowledge}
</div>
|]}
{renderKnowledgeSection knowledgeHighlights}
</div>
</div>
</div>
|]
where
renderCorrelation c = [hsx|
<div class="flex items-center gap-3">
<span class="text-sm text-gray-700 w-32 truncate">{c.annotationCategory}</span>
<div class="flex-1 bg-gray-200 rounded-full h-2">
<div class={barColor c.correlationScore}
style={"width:" <> show (round (c.correlationScore * 100) :: Int) <> "%"}></div>
</div>
<span class="text-xs text-gray-500">{show (round (c.correlationScore * 100) :: Int)}%</span>
</div>
|]
renderCorrelationsSection :: [OutcomeCorrelation] -> Html
renderCorrelationsSection [] = [hsx|<p class="text-sm text-gray-400">No data — run correlation analysis per hub.</p>|]
renderCorrelationsSection cs = [hsx|
<div class="space-y-2">
{forEach cs renderCorrelation}
</div>
|]
barColor s
| s >= 0.7 = "h-2 rounded-full bg-green-500" :: Text
| s >= 0.4 = "h-2 rounded-full bg-yellow-500"
| otherwise = "h-2 rounded-full bg-red-400"
renderPatternRankingsSection :: [PatternPerformanceRecord] -> Html
renderPatternRankingsSection [] = [hsx|<p class="text-sm text-gray-400">No data — run pattern performance per hub.</p>|]
renderPatternRankingsSection rs = [hsx|
<div class="space-y-2">
{forEach rs renderPatternRank}
</div>
|]
renderPatternRank r =
let rate = if r.totalOutcomeCount > 0
then fromIntegral r.positiveOutcomeCount / fromIntegral r.totalOutcomeCount :: Double
else 0.0
in [hsx|
<div class="flex items-center gap-2">
<span class="text-xs text-gray-400 w-5">{maybe "-" show r.outcomeRank}</span>
<a href={ShowWidgetPatternAction { widgetPatternId = r.widgetPatternId }}
class="text-sm text-blue-600 hover:underline truncate flex-1">
{show r.widgetPatternId}
</a>
<span class="text-xs text-gray-500">{show (round (rate * 100) :: Int)}%</span>
</div>
|]
renderInsightsSection :: [LearningInsight] -> Html
renderInsightsSection [] = [hsx|<p class="text-sm text-gray-400">No insights yet.</p>|]
renderInsightsSection is = [hsx|
<div class="space-y-3">
{forEach is renderInsight}
</div>
|]
renderThresholdStatus (h, mCfg) =
let driftClass = case mCfg of
Nothing -> "text-red-500" :: Text
Just cfg -> "text-green-600"
label = case mCfg of
Nothing -> "Not calibrated"
Just cfg -> "Calibrated"
in [hsx|
<div class="flex justify-between text-sm">
<span class="text-gray-700">{h.name}</span>
<span class={driftClass}>{label}</span>
</div>
|]
renderKnowledgeSection :: [InstitutionalKnowledgeEntry] -> Html
renderKnowledgeSection [] = [hsx|<p class="text-sm text-gray-400">No entries yet — distil a decision.</p>|]
renderKnowledgeSection es = [hsx|
<div class="space-y-3">
{forEach es renderKnowledge}
</div>
|]
renderInsight i = [hsx|
<div class="border-l-4 border-indigo-400 pl-3">
<p class="text-xs font-medium text-gray-700">{i.title}</p>
<p class="text-xs text-gray-400">{insightTypeBadge i.insightType}</p>
</div>
|]
renderCorrelation :: OutcomeCorrelation -> Html
renderCorrelation c = [hsx|
<div class="flex items-center gap-3">
<span class="text-sm text-gray-700 w-32 truncate">{c.annotationCategory}</span>
<div class="flex-1 bg-gray-200 rounded-full h-2">
<div class={barColor c.correlationScore}
style={"width:" <> show (round (c.correlationScore * 100) :: Int) <> "%"}></div>
</div>
<span class="text-xs text-gray-500">{show (round (c.correlationScore * 100) :: Int)}%</span>
</div>
|]
insightTypeBadge t = case t of
"annotation_predictor" -> "Annotation predictor" :: Text
"threshold_calibration" -> "Threshold calibration"
"pattern_ranking" -> "Pattern ranking"
"routing_improvement" -> "Routing improvement"
_ -> t
barColor :: Double -> Text
barColor s
| s >= 0.7 = "h-2 rounded-full bg-green-500"
| s >= 0.4 = "h-2 rounded-full bg-yellow-500"
| otherwise = "h-2 rounded-full bg-red-400"
renderKnowledge e = [hsx|
<div>
<a href={ShowInstitutionalKnowledgeAction { knowledgeEntryId = e.id }}
class="text-sm text-blue-600 hover:underline">
{take 80 e.summary <> if length e.summary > 80 then "…" else ""}
</a>
</div>
|]
renderPatternRank :: PatternPerformanceRecord -> Html
renderPatternRank r =
let rate = if r.totalOutcomeCount > 0
then fromIntegral r.positiveOutcomeCount / fromIntegral r.totalOutcomeCount :: Double
else 0.0
in [hsx|
<div class="flex items-center gap-2">
<span class="text-xs text-gray-400 w-5">{maybe "-" show r.outcomeRank}</span>
<a href={ShowWidgetPatternAction (r.widgetPatternId)}
class="text-sm text-blue-600 hover:underline truncate flex-1">
{show r.widgetPatternId}
</a>
<span class="text-xs text-gray-500">{show (round (rate * 100) :: Int)}%</span>
</div>
|]
renderThresholdStatus :: (Hub, Maybe AdaptiveThresholdConfig) -> Html
renderThresholdStatus (h, mCfg) =
let driftClass = case mCfg of
Nothing -> "text-red-500" :: Text
Just _ -> "text-green-600"
label = case mCfg of
Nothing -> "Not calibrated" :: Text
Just _ -> "Calibrated"
in [hsx|
<div class="flex justify-between text-sm">
<span class="text-gray-700">{h.name}</span>
<span class={driftClass}>{label}</span>
</div>
|]
renderInsight :: LearningInsight -> Html
renderInsight i = [hsx|
<div class="border-l-4 border-indigo-400 pl-3">
<p class="text-xs font-medium text-gray-700">{i.title}</p>
<p class="text-xs text-gray-400">{insightTypeBadge i.insightType}</p>
</div>
|]
insightTypeBadge :: Text -> Text
insightTypeBadge t = case t of
"annotation_predictor" -> "Annotation predictor"
"threshold_calibration" -> "Threshold calibration"
"pattern_ranking" -> "Pattern ranking"
"routing_improvement" -> "Routing improvement"
_ -> t
renderKnowledge :: InstitutionalKnowledgeEntry -> Html
renderKnowledge e = [hsx|
<div>
<a href={ShowInstitutionalKnowledgeAction (e.id)}
class="text-sm text-blue-600 hover:underline">
{take 80 e.summary <> if length e.summary > 80 then "…" else ""}
</a>
</div>
|]

4
Web/View/LineageEnrichment/Index.hs
View File

@@ -1,6 +1,6 @@
module Web.View.LineageEnrichment.Index where
import Web.View.Prelude
import IHP.ViewPrelude
data IndexView = IndexView
{ hubs :: ![Hub]
@@ -35,7 +35,7 @@ instance View IndexView where
{show unenriched} decision(s) pending enrichment
</p>
</div>
<form method="POST" action={EnrichLineageAction { hubIdForLineage = h.id }}>
<form method="POST" action={EnrichLineageAction (h.id)}>
{csrfTokenTag}
<button type="submit"
class="px-3 py-1.5 text-sm bg-green-600 text-white rounded hover:bg-green-700"

68
Web/View/MarketplaceDashboard/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Aeson (Value(..), decode, encode)
import qualified Data.ByteString.Lazy.Char8 as BL
@@ -35,18 +36,7 @@ instance View ShowView where
{searchBar searchQuery selectedType sortOrder widgetTypeOptions}
{if not (null trending)
then [hsx|
<div class="mb-6">
<h2 class="text-sm font-semibold text-gray-600 uppercase tracking-wide mb-3">
Trending (last 30 days)
</h2>
<div class="flex flex-wrap gap-2">
{forEach trending renderTrendingChip}
</div>
</div>
|]
else mempty}
{renderTrendingSection trending}
<div class="grid grid-cols-2 gap-8">
<div>
@@ -56,9 +46,7 @@ instance View ShowView where
</h2>
<div class="space-y-2">
{forEach patterns renderPatternRow}
{if null patterns
then [hsx|<p class="text-sm text-gray-400">No patterns match your search.</p>|]
else mempty}
{if null patterns then noPatternsMsg else mempty}
</div>
</div>
<div>
@@ -68,9 +56,7 @@ instance View ShowView where
</h2>
<div class="space-y-2">
{forEach templates renderTemplateRow}
{if null templates
then [hsx|<p class="text-sm text-gray-400">No templates match your search.</p>|]
else mempty}
{if null templates then noTemplatesMsg else mempty}
</div>
</div>
</div>
@@ -89,9 +75,7 @@ searchBar mSearch mWType sortOrder wtOptions = [hsx|
<label class="block text-xs text-gray-500 mb-1">Widget Type</label>
<select name="widgetType" class="border border-gray-300 rounded px-3 py-2 text-sm font-mono">
<option value="">All types</option>
{forEach wtOptions (\(n, l) -> [hsx|
<option value={n} selected={mWType == Just n}>{l}</option>
|])}
{forEach wtOptions (renderWtOption mWType)}
</select>
</div>
<div>
@@ -113,14 +97,14 @@ renderPatternRow :: PatternRow -> Html
renderPatternRow (pattern, adopterCount) = [hsx|
<div class="bg-white rounded border border-gray-200 p-3 hover:border-indigo-200">
<div class="flex items-center justify-between">
<a href={ShowWidgetPatternAction { widgetPatternId = pattern.id }}
<a href={ShowWidgetPatternAction (pattern.id)}
class="font-medium text-sm text-indigo-700 hover:underline">
{pattern.name}
</a>
<span class="text-xs text-gray-400">{tshow adopterCount} adopters</span>
</div>
<span class="font-mono text-xs text-gray-400">{pattern.widgetType}</span>
{maybe mempty (\d -> [hsx|<p class="text-xs text-gray-500 mt-1 truncate">{d}</p>|]) pattern.description}
{maybe mempty renderPatternDesc pattern.description}
</div>
|]
@@ -128,24 +112,22 @@ renderTemplateRow :: TemplateRow -> Html
renderTemplateRow (template, cloneCount) = [hsx|
<div class="bg-white rounded border border-gray-200 p-3 hover:border-indigo-200">
<div class="flex items-center justify-between">
<a href={ShowGovernanceTemplateAction { governanceTemplateId = template.id }}
<a href={ShowGovernanceTemplateAction (template.id)}
class="font-medium text-sm text-indigo-700 hover:underline">
{template.name}
</a>
<span class="text-xs text-gray-400">{tshow cloneCount} clones</span>
</div>
{maybe mempty (\d -> [hsx|<p class="text-xs text-gray-500 mt-1 truncate">{d}</p>|]) template.description}
{maybe mempty renderPatternDesc template.description}
<div class="mt-1 flex flex-wrap gap-1">
{forEach (jsonArrayTexts template.categories) (\c -> [hsx|
<span class="px-1.5 py-0.5 rounded text-xs bg-blue-50 text-blue-600 font-mono">{c}</span>
|])}
{forEach (jsonArrayTexts template.categories) renderCategoryChip}
</div>
</div>
|]
renderTrendingChip :: TrendingRow -> Html
renderTrendingChip (patternId, name, widgetType, count) = [hsx|
<a href={ShowWidgetPatternAction { widgetPatternId = patternId }}
<a href={ShowWidgetPatternAction (patternId)}
class="flex items-center gap-1.5 px-3 py-1.5 bg-white rounded border border-gray-200 \
\text-sm hover:border-indigo-300">
<span class="font-medium">{name}</span>
@@ -158,3 +140,31 @@ jsonArrayTexts :: Value -> [Text]
jsonArrayTexts val = case decode (encode val) of
Just (arr :: [Text]) -> arr
Nothing -> []
renderTrendingSection :: [TrendingRow] -> Html
renderTrendingSection [] = mempty
renderTrendingSection rows = [hsx|
<div class="mb-6">
<h2 class="text-sm font-semibold text-gray-600 uppercase tracking-wide mb-3">
Trending (last 30 days)
</h2>
<div class="flex flex-wrap gap-2">
{forEach rows renderTrendingChip}
</div>
</div>
|]
noPatternsMsg :: Html
noPatternsMsg = [hsx|<p class="text-sm text-gray-400">No patterns match your search.</p>|]
noTemplatesMsg :: Html
noTemplatesMsg = [hsx|<p class="text-sm text-gray-400">No templates match your search.</p>|]
renderPatternDesc :: Text -> Html
renderPatternDesc d = [hsx|<p class="text-xs text-gray-500 mt-1 truncate">{d}</p>|]
renderCategoryChip :: Text -> Html
renderCategoryChip c = [hsx|<span class="px-1.5 py-0.5 rounded text-xs bg-blue-50 text-blue-600 font-mono">{c}</span>|]
renderWtOption :: Maybe Text -> (Text, Text) -> Html
renderWtOption mWType (n, l) = [hsx|<option value={n} selected={mWType == Just n}>{l}</option>|]

10
Web/View/ModelRoutingPolicies/Index.hs
View File

@@ -1,6 +1,6 @@
module Web.View.ModelRoutingPolicies.Index where
import Web.View.Prelude
import IHP.ViewPrelude
data IndexView = IndexView
{ policies :: ![ModelRoutingPolicy]
@@ -51,9 +51,7 @@ instance View IndexView where
</td>
<td class="px-6 py-4 text-sm text-gray-500">{show p.priority}</td>
<td class="px-6 py-4 text-sm">
{if p.isActive
then [hsx|<span class="text-green-600">Yes</span>|]
else [hsx|<span class="text-gray-400">No</span>|]}
{renderActiveStatus p.isActive}
</td>
<td class="px-6 py-4 text-right">
<a href={DeleteModelRoutingPolicyAction p.id}
@@ -63,3 +61,7 @@ instance View IndexView where
</td>
</tr>
|]
renderActiveStatus :: Bool -> Html
renderActiveStatus True = [hsx|<span class="text-green-600">Yes</span>|]
renderActiveStatus False = [hsx|<span class="text-gray-400">No</span>|]

21
Web/View/ModelRoutingPolicies/New.hs
View File

@@ -1,6 +1,6 @@
module Web.View.ModelRoutingPolicies.New where
import Web.View.Prelude
import IHP.ViewPrelude
data NewView = NewView
{ policy :: !ModelRoutingPolicy
@@ -26,24 +26,22 @@ instance View NewView where
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Hub</label>
<select name="hubId" class="block w-full border-gray-300 rounded-md shadow-sm text-sm">
{forEach hubs \h -> [hsx|<option value={show h.id}>{h.name}</option>|]}
{forEach hubs renderHubOption}
</select>
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Task Type</label>
<select name="taskType" class="block w-full border-gray-300 rounded-md shadow-sm text-sm">
{forEach taskTypeOptions \t -> [hsx|<option value={t}>{t}</option>|]}
{forEach taskTypeOptions renderTaskTypeOption}
</select>
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Agent</label>
<select name="agentRegistrationId" class="block w-full border-gray-300 rounded-md shadow-sm text-sm">
{forEach agents \a -> [hsx|
<option value={show a.id}>{a.name} ({a.provider} / {a.modelName})</option>
|]}
{forEach agents renderAgentOption}
</select>
</div>
<div>{(numberField #priority) { label = "Priority (higher wins)", placeholder = "0" }}</div>
<div>{(numberField #priority) { fieldLabel = "Priority (higher wins)", placeholder = "0" }}</div>
<div class="flex gap-3 pt-2">
{submitButton { label = "Create Policy" }}
<a href={ModelRoutingPoliciesAction}
@@ -53,3 +51,12 @@ instance View NewView where
|]}
</div>
|]
renderHubOption :: Hub -> Html
renderHubOption h = [hsx|<option value={show h.id}>{h.name}</option>|]
renderTaskTypeOption :: Text -> Html
renderTaskTypeOption t = [hsx|<option value={t}>{t}</option>|]
renderAgentOption :: AgentRegistration -> Html
renderAgentOption a = [hsx|<option value={show a.id}>{a.name} ({a.provider} / {a.modelName})</option>|]

14
Web/View/OutcomeCorrelations/Index.hs
View File

@@ -1,6 +1,6 @@
module Web.View.OutcomeCorrelations.Index where
import Web.View.Prelude
import IHP.ViewPrelude
data IndexView = IndexView
{ correlations :: ![OutcomeCorrelation]
@@ -20,12 +20,7 @@ instance View IndexView where
<label class="block text-sm font-medium text-gray-700 mb-1">Filter by Hub</label>
<select name="hubId" class="border border-gray-300 rounded-md px-3 py-2 text-sm">
<option value="">All hubs</option>
{forM_ hubs \h -> [hsx|
<option value={show h.id}
selected={mHubFilter == Just h.id}>
{h.name}
</option>
|]}
{forEach hubs (renderHubFilterOption mHubFilter)}
</select>
</div>
<button type="submit" class="px-4 py-2 bg-gray-600 text-white rounded-md text-sm hover:bg-gray-700">
@@ -69,3 +64,8 @@ instance View IndexView where
| s >= 0.7 = "inline-block px-2 py-1 text-xs font-semibold bg-green-100 text-green-800 rounded" :: Text
| s >= 0.4 = "inline-block px-2 py-1 text-xs font-semibold bg-yellow-100 text-yellow-800 rounded"
| otherwise = "inline-block px-2 py-1 text-xs font-semibold bg-red-100 text-red-800 rounded"
renderHubFilterOption :: Maybe (Id Hub) -> Hub -> Html
renderHubFilterOption mFilter h = [hsx|
<option value={show h.id} selected={mFilter == Just h.id}>{h.name}</option>
|]

25
Web/View/PatternPerformance/Index.hs
View File

@@ -1,6 +1,6 @@
module Web.View.PatternPerformance.Index where
import Web.View.Prelude
import IHP.ViewPrelude
data IndexView = IndexView
{ records :: ![PatternPerformanceRecord]
@@ -14,15 +14,7 @@ instance View IndexView where
<h1 class="text-2xl font-bold text-gray-900">Pattern Performance</h1>
</div>
<div class="mb-4 flex gap-2 flex-wrap">
{forM_ hubs \h -> [hsx|
<form method="POST" action={ComputePatternPerformanceAction { hubIdForPerformance = h.id }} class="inline">
{csrfTokenTag}
<button type="submit"
class="px-3 py-1.5 text-sm bg-indigo-600 text-white rounded hover:bg-indigo-700">
Recompute for {h.name}
</button>
</form>
|]}
{forEach hubs renderRecomputeButton}
</div>
<div class="bg-white shadow rounded-lg overflow-hidden">
<table class="min-w-full divide-y divide-gray-200">
@@ -53,7 +45,7 @@ instance View IndexView where
<tr>
<td class="px-6 py-4 text-sm text-gray-500">{rankLabel}</td>
<td class="px-6 py-4 text-sm font-medium text-gray-900">
<a href={ShowWidgetPatternAction { widgetPatternId = r.widgetPatternId }}
<a href={ShowWidgetPatternAction (r.widgetPatternId)}
class="text-blue-600 hover:underline">{show r.widgetPatternId}</a>
</td>
<td class="px-6 py-4 text-sm text-gray-500">{show r.adoptionCount}</td>
@@ -62,3 +54,14 @@ instance View IndexView where
<td class="px-6 py-4 text-sm text-gray-500">{maybe "-" show r.meanOutcomeValue}</td>
</tr>
|]
renderRecomputeButton :: Hub -> Html
renderRecomputeButton h = [hsx|
<form method="POST" action={ComputePatternPerformanceAction (h.id)} class="inline">
{csrfTokenTag}
<button type="submit"
class="px-3 py-1.5 text-sm bg-indigo-600 text-white rounded hover:bg-indigo-700">
Recompute for {h.name}
</button>
</form>
|]

12
Web/View/Prelude.hs Normal file
View File

@@ -0,0 +1,12 @@
module Web.View.Prelude
( module Web.Types
, module Generated.Types
, module IHP.Prelude
, module IHP.ViewPrelude
) where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()

3
Web/View/RequirementCandidates/Edit.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data EditView = EditView
{ candidate :: !RequirementCandidate
@@ -16,7 +17,7 @@ instance View EditView where
<div class="mb-6 flex items-center gap-2 text-sm text-gray-500">
<a href={RequirementCandidatesAction} class="hover:text-gray-700">Candidates</a>
<span>/</span>
<a href={ShowRequirementCandidateAction { requirementCandidateId = candidate.id }}
<a href={ShowRequirementCandidateAction (candidate.id)}
class="hover:text-gray-700">{candidate.title}</a>
<span>/</span>
<span>Edit</span>

47
Web/View/RequirementCandidates/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data IndexView = IndexView
{ candidates :: ![RequirementCandidate]
@@ -33,27 +34,7 @@ instance View IndexView where
{renderFilterPills mStatusFilter}
</div>
{if null candidates
then [hsx|<p class="text-sm text-gray-500">No candidates found.</p>|]
else [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Title</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Widget</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Category</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Status</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Reviewer</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Created</th>
</tr>
</thead>
<tbody>
{forEach candidates (renderRow assignments users widgets)}
</tbody>
</table>
</div>
|]}
{renderCandidatesTable candidates assignments users widgets}
|]
renderFilterPills :: Maybe Text -> Html
@@ -78,6 +59,28 @@ renderPill target current label =
Just s -> pathTo RequirementCandidatesAction <> "?status=" <> s
in [hsx|<a href={url} class={cls}>{label}</a>|]
renderCandidatesTable :: [RequirementCandidate] -> [ReviewerAssignment] -> [User] -> [Widget] -> Html
renderCandidatesTable [] _ _ _ = [hsx|<p class="text-sm text-gray-500">No candidates found.</p>|]
renderCandidatesTable candidates assignments users ws = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-700">Title</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Widget</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Category</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Status</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Reviewer</th>
<th class="text-left px-4 py-3 font-medium text-gray-700">Created</th>
</tr>
</thead>
<tbody>
{forEach candidates (renderRow assignments users ws)}
</tbody>
</table>
</div>
|]
renderRow :: [ReviewerAssignment] -> [User] -> [Widget] -> RequirementCandidate -> Html
renderRow assignments users widgets c =
let mAssignment = find (\ra -> ra.candidateId == c.id) assignments
@@ -86,7 +89,7 @@ renderRow assignments users widgets c =
in [hsx|
<tr class="border-b border-gray-100 hover:bg-gray-50">
<td class="px-4 py-3">
<a href={ShowRequirementCandidateAction { requirementCandidateId = c.id }}
<a href={ShowRequirementCandidateAction (c.id)}
class="font-medium text-indigo-600 hover:text-indigo-800">
{c.title}
</a>

1
Web/View/RequirementCandidates/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView
{ candidate :: !RequirementCandidate

53
Web/View/RequirementCandidates/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data ShowView = ShowView
{ candidate :: !RequirementCandidate
@@ -29,17 +30,17 @@ instance View ShowView where
<div class="flex items-start justify-between mb-3">
<h1 class="text-2xl font-semibold">{candidate.title}</h1>
<div class="flex gap-2 ml-4 flex-wrap">
<form method="POST" action={DetectDuplicatesAction { requirementCandidateId = candidate.id }} class="inline">
<form method="POST" action={DetectDuplicatesAction (candidate.id)} class="inline">
<button type="submit" class="text-sm border border-orange-300 text-orange-700 px-3 py-1.5 rounded hover:bg-orange-50">
Check Duplicates
</button>
</form>
<form method="POST" action={DetectPolicySensitivityAction { requirementCandidateId = candidate.id }} class="inline">
<form method="POST" action={DetectPolicySensitivityAction (candidate.id)} class="inline">
<button type="submit" class="text-sm border border-red-300 text-red-700 px-3 py-1.5 rounded hover:bg-red-50">
Policy Check
</button>
</form>
<a href={EditRequirementCandidateAction { requirementCandidateId = candidate.id }}
<a href={EditRequirementCandidateAction (candidate.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Edit
</a>
@@ -83,13 +84,7 @@ instance View ShowView where
<!-- Triage history -->
<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">Triage History</h2>
{if null triageStates
then [hsx|<p class="text-sm text-gray-400">No triage actions recorded yet.</p>|]
else [hsx|
<ol class="space-y-2">
{forEach triageStates renderTriageRow}
</ol>
|]}
{renderTriageHistory triageStates}
</div>
</div>
|]
@@ -105,7 +100,7 @@ renderSource (Just a) _ = [hsx|
renderSource Nothing (Just t) = [hsx|
<div class="text-sm">
<p class="text-gray-500 mb-1">Source thread:</p>
<a href={ShowAnnotationThreadAction { annotationThreadId = t.id }}
<a href={ShowAnnotationThreadAction (t.id)}
class="text-indigo-600 hover:text-indigo-800">{t.title}</a>
</div>
|]
@@ -125,7 +120,7 @@ allowedNextStatuses _ = []
renderTriageButton :: Id RequirementCandidate -> Text -> Html
renderTriageButton candidateId newStatus = [hsx|
<form method="POST" action={UpdateTriageStatusAction { requirementCandidateId = candidateId }}
<form method="POST" action={UpdateTriageStatusAction (candidateId)}
class="inline">
{hiddenField "authenticity_token"}
<input type="hidden" name="status" value={newStatus} />
@@ -145,15 +140,13 @@ renderReviewerSection :: RequirementCandidate -> Maybe ReviewerAssignment -> [Us
renderReviewerSection candidate mAssignment users = [hsx|
<div class="flex items-center gap-4">
<div class="text-sm text-gray-600">
{case mAssignment of
Nothing -> [hsx|<span class="text-gray-400">Unassigned</span>|]
Just ra -> [hsx|<span>{reviewerName ra users}</span>|]}
{renderAssignmentStatus mAssignment users}
</div>
<form method="POST" action={AssignReviewerAction { requirementCandidateId = candidate.id }}
<form method="POST" action={AssignReviewerAction (candidate.id)}
class="flex items-center gap-2">
{hiddenField "authenticity_token"}
<select name="userId" class="text-sm border border-gray-300 rounded px-2 py-1">
{forEach users (\u -> [hsx|<option value={show u.id}>{u.name}</option>|])}
{forEach users renderUserOption}
</select>
<button type="submit"
class="text-sm bg-indigo-600 text-white px-3 py-1 rounded hover:bg-indigo-700">
@@ -167,6 +160,24 @@ reviewerName :: ReviewerAssignment -> [User] -> Text
reviewerName ra users =
maybe "Unknown" (.name) (find (\u -> u.id == ra.userId) users)
renderTriageHistory :: [TriageState] -> Html
renderTriageHistory [] = [hsx|<p class="text-sm text-gray-400">No triage actions recorded yet.</p>|]
renderTriageHistory states = [hsx|
<ol class="space-y-2">
{forEach states renderTriageRow}
</ol>
|]
renderAssignmentStatus :: Maybe ReviewerAssignment -> [User] -> Html
renderAssignmentStatus Nothing _ = [hsx|<span class="text-gray-400">Unassigned</span>|]
renderAssignmentStatus (Just ra) users = [hsx|<span>{reviewerName ra users}</span>|]
renderUserOption :: User -> Html
renderUserOption u = [hsx|<option value={show u.id}>{u.name}</option>|]
renderTriageNote :: Text -> Html
renderTriageNote n = [hsx|<p class="text-gray-700">{n}</p>|]
renderTriageRow :: TriageState -> Html
renderTriageRow ts = [hsx|
<li class="flex items-start gap-3 text-sm">
@@ -174,7 +185,7 @@ renderTriageRow ts = [hsx|
{ts.status}
</span>
<div>
{maybe mempty (\n -> [hsx|<p class="text-gray-700">{n}</p>|]) ts.notes}
{maybe mempty renderTriageNote ts.notes}
<p class="text-xs text-gray-400">{show ts.changedAt}</p>
</div>
</li>
@@ -197,14 +208,14 @@ renderPromoteButton :: RequirementCandidate -> Html
renderPromoteButton candidate =
case candidate.requirementId of
Just rid -> [hsx|
<a href={ShowRequirementAction { requirementId = rid }}
<a href={ShowRequirementAction (rid)}
class="text-sm text-green-700 bg-green-50 border border-green-200 px-3 py-1.5 rounded hover:bg-green-100">
Requirement →
</a>
|]
Nothing -> [hsx|
<form method="POST"
action={PromoteToRequirementAction { requirementCandidateId = candidate.id }}>
action={PromoteToRequirementAction (candidate.id)}>
{hiddenField "authenticity_token"}
<button type="submit"
class="text-sm bg-indigo-600 text-white px-3 py-1.5 rounded hover:bg-indigo-700">
@@ -216,7 +227,7 @@ renderPromoteButton candidate =
renderLinkDecisionButton :: RequirementCandidate -> Html
renderLinkDecisionButton candidate = [hsx|
<form method="POST"
action={LinkToDecisionAction { requirementCandidateId = candidate.id }}>
action={LinkToDecisionAction (candidate.id)}>
{hiddenField "authenticity_token"}
<button type="submit"
class="text-sm bg-gray-700 text-white px-3 py-1.5 rounded hover:bg-gray-800">

11
Web/View/Requirements/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data IndexView = IndexView
{ requirements :: ![Requirement]
@@ -15,11 +16,13 @@ instance View IndexView where
<div class="flex items-center justify-between mb-6">
<h1 class="text-2xl font-semibold">Requirements</h1>
</div>
{if null requirements
then [hsx|<p class="text-sm text-gray-400">No requirements yet. Promote an accepted candidate to create one.</p>|]
else renderTable requirements candidates}
{renderRequirementsSection requirements candidates}
|]
renderRequirementsSection :: [Requirement] -> [RequirementCandidate] -> Html
renderRequirementsSection [] _ = [hsx|<p class="text-sm text-gray-400">No requirements yet. Promote an accepted candidate to create one.</p>|]
renderRequirementsSection reqs candidates = renderTable reqs candidates
renderTable :: [Requirement] -> [RequirementCandidate] -> Html
renderTable reqs candidates = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
@@ -43,7 +46,7 @@ renderRow :: [RequirementCandidate] -> Requirement -> Html
renderRow candidates req = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3">
<a href={ShowRequirementAction { requirementId = req.id }}
<a href={ShowRequirementAction (req.id)}
class="text-indigo-600 hover:text-indigo-800 font-medium">{req.title}</a>
</td>
<td class="px-4 py-3">

23
Web/View/Requirements/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data ShowView = ShowView
{ requirement :: !Requirement
@@ -35,7 +36,7 @@ instance View ShowView where
<!-- Source candidate -->
<div class="bg-white rounded-lg border border-gray-200 px-6 py-4">
<h2 class="text-sm font-semibold text-gray-700 mb-2">Source Candidate</h2>
<a href={ShowRequirementCandidateAction { requirementCandidateId = candidate.id }}
<a href={ShowRequirementCandidateAction (candidate.id)}
class="text-sm text-indigo-600 hover:text-indigo-800">{candidate.title}</a>
<p class="text-xs text-gray-400 mt-1">Widget: {widget.name}</p>
</div>
@@ -43,15 +44,7 @@ instance View ShowView where
<!-- Linked decision -->
<div class="bg-white rounded-lg border border-gray-200 px-6 py-4">
<h2 class="text-sm font-semibold text-gray-700 mb-2">Linked Decision</h2>
{case mDecision of
Nothing -> [hsx|<p class="text-sm text-gray-400">No decision linked yet.</p>|]
Just dr -> [hsx|
<a href={ShowDecisionRecordAction { decisionRecordId = dr.id }}
class="text-sm text-indigo-600 hover:text-indigo-800">{dr.title}</a>
<span class={outcomeClass dr.outcome <> " text-xs px-2 py-0.5 rounded font-medium ml-2"}>
{dr.outcome}
</span>
|]}
{renderLinkedDecision mDecision}
</div>
</div>
|]
@@ -62,6 +55,16 @@ reqStatusClass "superseded" = "bg-yellow-100 text-yellow-800"
reqStatusClass "withdrawn" = "bg-gray-100 text-gray-500"
reqStatusClass _ = "bg-gray-100 text-gray-600"
renderLinkedDecision :: Maybe DecisionRecord -> Html
renderLinkedDecision Nothing = [hsx|<p class="text-sm text-gray-400">No decision linked yet.</p>|]
renderLinkedDecision (Just dr) = [hsx|
<a href={ShowDecisionRecordAction (dr.id)}
class="text-sm text-indigo-600 hover:text-indigo-800">{dr.title}</a>
<span class={outcomeClass dr.outcome <> " text-xs px-2 py-0.5 rounded font-medium ml-2"}>
{dr.outcome}
</span>
|]
outcomeClass :: Text -> Text
outcomeClass "accepted" = "bg-green-100 text-green-800"
outcomeClass "rejected" = "bg-red-100 text-red-800"

1
Web/View/Sessions/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView { user :: !User }

112
Web/View/StewardshipRoles/Index.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data IndexView = IndexView
{ roles :: ![StewardshipRole]
@@ -20,62 +21,65 @@ instance View IndexView where
</a>
</div>
{if null roles
then [hsx|<p class="text-sm text-gray-400">No stewardship roles assigned yet.</p>|]
else [hsx|
<div class="space-y-6">
{forEach hubGroups renderHubGroup}
</div>
|]}
{renderRolesSection hubGroups}
|]
where
hubName hid = maybe (show hid) (.name) (find (\h -> h.id == hid) hubs)
hubGroups = groupByHub hubs roles
hubGroups = groupByHub hubs roles
groupByHub :: [Hub] -> [StewardshipRole] -> [(Hub, [StewardshipRole])]
groupByHub hs rs =
[ (h, filter (\r -> r.hubId == h.id) rs)
| h <- hs
, any (\r -> r.hubId == h.id) rs
]
groupByHub :: [Hub] -> [StewardshipRole] -> [(Hub, [StewardshipRole])]
groupByHub hs rs =
[ (h, filter (\r -> r.hubId == h.id) rs)
| h <- hs
, any (\r -> r.hubId == h.id) rs
]
renderHubGroup :: (Hub, [StewardshipRole]) -> Html
renderHubGroup (hub, hubRoles) = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<div class="bg-gray-50 border-b border-gray-200 px-4 py-3">
<h2 class="font-medium text-gray-700">{hub.name}</h2>
</div>
<table class="w-full text-sm">
<thead>
<tr>
<th class="text-left px-4 py-2 font-medium text-gray-600">Role</th>
<th class="text-left px-4 py-2 font-medium text-gray-600">Assigned To</th>
<th class="text-left px-4 py-2 font-medium text-gray-600">Granted</th>
<th class="text-left px-4 py-2 font-medium text-gray-600">Status</th>
<th class="px-4 py-2"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach hubRoles renderRoleRow}
</tbody>
</table>
</div>
|]
renderHubGroup :: (Hub, [StewardshipRole]) -> Html
renderHubGroup (hub, hubRoles) = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<div class="bg-gray-50 border-b border-gray-200 px-4 py-3">
<h2 class="font-medium text-gray-700">{hub.name}</h2>
</div>
<table class="w-full text-sm">
<thead>
<tr>
<th class="text-left px-4 py-2 font-medium text-gray-600">Role</th>
<th class="text-left px-4 py-2 font-medium text-gray-600">Assigned To</th>
<th class="text-left px-4 py-2 font-medium text-gray-600">Granted</th>
<th class="text-left px-4 py-2 font-medium text-gray-600">Status</th>
<th class="px-4 py-2"></th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach hubRoles renderRoleRow}
</tbody>
</table>
</div>
|]
renderRoleRow :: StewardshipRole -> Html
renderRoleRow r = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3 font-medium text-gray-800">{r.roleName}</td>
<td class="px-4 py-3 text-gray-600">{r.assignedTo}</td>
<td class="px-4 py-3 text-xs text-gray-400">{show r.grantedAt}</td>
<td class="px-4 py-3">
{if isNothing r.revokedAt
then [hsx|<span class="text-xs bg-green-100 text-green-700 px-2 py-0.5 rounded font-medium">active</span>|]
else [hsx|<span class="text-xs bg-gray-100 text-gray-500 px-2 py-0.5 rounded font-medium">revoked</span>|]}
</td>
<td class="px-4 py-3 text-right">
<a href={ShowStewardshipRoleAction { stewardshipRoleId = r.id }}
class="text-xs text-blue-600 hover:underline">View</a>
</td>
</tr>
|]
renderRoleRow :: StewardshipRole -> Html
renderRoleRow r = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3 font-medium text-gray-800">{r.roleName}</td>
<td class="px-4 py-3 text-gray-600">{r.assignedTo}</td>
<td class="px-4 py-3 text-xs text-gray-400">{show r.grantedAt}</td>
<td class="px-4 py-3">
{renderRoleStatus (isNothing r.revokedAt)}
</td>
<td class="px-4 py-3 text-right">
<a href={ShowStewardshipRoleAction (r.id)}
class="text-xs text-blue-600 hover:underline">View</a>
</td>
</tr>
|]
renderRolesSection :: [(Hub, [StewardshipRole])] -> Html
renderRolesSection [] = [hsx|<p class="text-sm text-gray-400">No stewardship roles assigned yet.</p>|]
renderRolesSection groups = [hsx|
<div class="space-y-6">
{forEach groups renderHubGroup}
</div>
|]
renderRoleStatus :: Bool -> Html
renderRoleStatus True = [hsx|<span class="text-xs bg-green-100 text-green-700 px-2 py-0.5 rounded font-medium">active</span>|]
renderRoleStatus False = [hsx|<span class="text-xs bg-gray-100 text-gray-500 px-2 py-0.5 rounded font-medium">revoked</span>|]

5
Web/View/StewardshipRoles/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView
{ role :: !StewardshipRole
@@ -20,9 +21,9 @@ instance View NewView where
renderForm :: StewardshipRole -> [Hub] -> Html
renderForm role hubs = formFor role [hsx|
{(selectField #hubId hubs){ label = "Hub" }}
{(selectField #hubId hubs){ fieldLabel = "Hub" }}
{(textField #roleName){ helpText = "e.g. Hub Lead, Policy Steward, Triage Owner" }}
{(textField #assignedTo){ helpText = "Person name or identifier" }}
{(textareaField #notes){ label = "Notes (optional)" }}
{(textareaField #notes){ fieldLabel = "Notes (optional)" }}
{submitButton}
|]

47
Web/View/StewardshipRoles/Show.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data ShowView = ShowView
{ role :: !StewardshipRole
@@ -17,9 +18,7 @@ instance View ShowView where
<a href={StewardshipRolesAction} class="text-sm text-gray-500 hover:underline">Stewards</a>
<span class="text-gray-300">/</span>
<h1 class="text-2xl font-semibold">{role.roleName}</h1>
{if isNothing role.revokedAt
then [hsx|<span class="text-sm bg-green-100 text-green-700 px-2 py-0.5 rounded font-medium">active</span>|]
else [hsx|<span class="text-sm bg-gray-100 text-gray-500 px-2 py-0.5 rounded font-medium">revoked</span>|]}
{renderRoleStatusBadge (isNothing role.revokedAt)}
</div>
<div class="bg-white rounded-lg border border-gray-200 p-6">
@@ -40,25 +39,33 @@ instance View ShowView where
<dt class="text-gray-500">Revoked At</dt>
<dd>{maybe "–" show role.revokedAt}</dd>
</div>
{whenJust role.notes \n -> [hsx|
<div class="col-span-2">
<dt class="text-gray-500">Notes</dt>
<dd class="text-gray-700">{n}</dd>
</div>
|]}
{maybe mempty renderRoleNotes role.notes}
</dl>
</div>
{if isNothing role.revokedAt
then [hsx|
<div class="mt-4">
<a href={RevokeRoleAction { stewardshipRoleId = role.id }}
class="text-sm text-red-600 hover:underline"
onclick="return confirm('Revoke this stewardship role?')">
Revoke Role
</a>
</div>
|]
else mempty}
{if isNothing role.revokedAt then renderRevokeLink role.id else mempty}
</div>
|]
renderRoleStatusBadge :: Bool -> Html
renderRoleStatusBadge True = [hsx|<span class="text-sm bg-green-100 text-green-700 px-2 py-0.5 rounded font-medium">active</span>|]
renderRoleStatusBadge False = [hsx|<span class="text-sm bg-gray-100 text-gray-500 px-2 py-0.5 rounded font-medium">revoked</span>|]
renderRoleNotes :: Text -> Html
renderRoleNotes n = [hsx|
<div class="col-span-2">
<dt class="text-gray-500">Notes</dt>
<dd class="text-gray-700">{n}</dd>
</div>
|]
renderRevokeLink :: Id StewardshipRole -> Html
renderRevokeLink rid = [hsx|
<div class="mt-4">
<a href={RevokeRoleAction (rid)}
class="text-sm text-red-600 hover:underline"
onclick="return confirm('Revoke this stewardship role?')">
Revoke Role
</a>
</div>
|]

41
Web/View/TypeRegistries/AnnotationCategories.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data AnnotationCategoriesView = AnnotationCategoriesView { entries :: ![AnnotationCategoryRegistry], hubs :: ![Hub] }
data ShowAnnotationCategoryView = ShowAnnotationCategoryView { entry :: !AnnotationCategoryRegistry, mOwner :: !(Maybe Hub) }
@@ -59,12 +60,12 @@ renderRow :: [Hub] -> AnnotationCategoryRegistry -> Html
renderRow hubs e = [hsx|
<tr class="border-b border-gray-100 hover:bg-gray-50">
<td class="px-4 py-3 font-mono text-xs">{e.name}</td>
<td class="px-4 py-3">{e.label}</td>
<td class="px-4 py-3">{e.label_}</td>
<td class="px-4 py-3 text-gray-500">{hubName hubs e.ownerHubId}</td>
<td class="px-4 py-3">{statusBadge e.status}</td>
<td class="px-4 py-3 text-right text-xs">
<a href={ShowAnnotationCategoryAction { annotationCategoryRegistryId = e.id }} class="text-gray-500 hover:text-gray-700 mr-2">View</a>
<a href={EditAnnotationCategoryAction { annotationCategoryRegistryId = e.id }} class="text-gray-500 hover:text-gray-700">Edit</a>
<a href={ShowAnnotationCategoryAction (e.id)} class="text-gray-500 hover:text-gray-700 mr-2">View</a>
<a href={EditAnnotationCategoryAction (e.id)} class="text-gray-500 hover:text-gray-700">Edit</a>
</td>
</tr>
|]
@@ -80,13 +81,13 @@ instance View ShowAnnotationCategoryView where
{statusBadge entry.status}
</div>
<dl class="space-y-3 text-sm">
<div><dt class="text-gray-500">Label</dt><dd class="font-medium">{entry.label}</dd></div>
<div><dt class="text-gray-500">Label</dt><dd class="font-medium">{entry.label_}</dd></div>
<div><dt class="text-gray-500">Description</dt><dd>{fromMaybe "—" entry.description}</dd></div>
<div><dt class="text-gray-500">Owner</dt><dd>{maybe "Framework (cross-domain)" (.name) mOwner}</dd></div>
<div><dt class="text-gray-500">Replaced by</dt><dd>{fromMaybe "—" entry.deprecatedInFavourOf}</dd></div>
</dl>
<div class="mt-6">
<a href={EditAnnotationCategoryAction { annotationCategoryRegistryId = entry.id }}
<a href={EditAnnotationCategoryAction (entry.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">Edit</a>
</div>
</div>
@@ -96,20 +97,10 @@ typeForm :: AnnotationCategoryRegistry -> [Hub] -> Bool -> Html
typeForm entry hubs isNew = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-6 max-w-lg">
<div class="space-y-4">
{if isNew then [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(permanent, lowercase-underscored)</span></label>
{(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
|] else [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(immutable)</span></label>
<p class="font-mono text-sm bg-gray-50 border border-gray-200 rounded px-3 py-2">{entry.name}</p>
</div>
|]}
{renderNameField isNew entry.name}
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Label</label>
{(textField #label) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
{(textField #label_) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Description <span class="text-gray-400 text-xs">(optional)</span></label>
@@ -145,7 +136,21 @@ instance View EditAnnotationCategoryView where
<a href={AnnotationCategoryRegistryAction} class="text-sm text-gray-500 hover:text-gray-700">← Annotation Categories</a>
</div>
<h1 class="text-xl font-semibold mb-6">Edit Annotation Category</h1>
<form method="POST" action={UpdateAnnotationCategoryAction { annotationCategoryRegistryId = entry.id }}>
<form method="POST" action={UpdateAnnotationCategoryAction (entry.id)}>
{typeForm entry hubs False}
</form>
|]
renderNameField :: Bool -> Text -> Html
renderNameField True _ = [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(permanent, lowercase-underscored)</span></label>
{(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
|]
renderNameField False name = [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(immutable)</span></label>
<p class="font-mono text-sm bg-gray-50 border border-gray-200 rounded px-3 py-2">{name}</p>
</div>
|]

41
Web/View/TypeRegistries/EventTypes.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data EventTypesView = EventTypesView { entries :: ![EventTypeRegistry], hubs :: ![Hub] }
data ShowEventTypeView = ShowEventTypeView { entry :: !EventTypeRegistry, mOwner :: !(Maybe Hub) }
@@ -59,12 +60,12 @@ renderRow :: [Hub] -> EventTypeRegistry -> Html
renderRow hubs e = [hsx|
<tr class="border-b border-gray-100 hover:bg-gray-50">
<td class="px-4 py-3 font-mono text-xs">{e.name}</td>
<td class="px-4 py-3">{e.label}</td>
<td class="px-4 py-3">{e.label_}</td>
<td class="px-4 py-3 text-gray-500">{hubName hubs e.ownerHubId}</td>
<td class="px-4 py-3">{statusBadge e.status}</td>
<td class="px-4 py-3 text-right text-xs">
<a href={ShowEventTypeAction { eventTypeRegistryId = e.id }} class="text-gray-500 hover:text-gray-700 mr-2">View</a>
<a href={EditEventTypeAction { eventTypeRegistryId = e.id }} class="text-gray-500 hover:text-gray-700">Edit</a>
<a href={ShowEventTypeAction (e.id)} class="text-gray-500 hover:text-gray-700 mr-2">View</a>
<a href={EditEventTypeAction (e.id)} class="text-gray-500 hover:text-gray-700">Edit</a>
</td>
</tr>
|]
@@ -80,13 +81,13 @@ instance View ShowEventTypeView where
{statusBadge entry.status}
</div>
<dl class="space-y-3 text-sm">
<div><dt class="text-gray-500">Label</dt><dd class="font-medium">{entry.label}</dd></div>
<div><dt class="text-gray-500">Label</dt><dd class="font-medium">{entry.label_}</dd></div>
<div><dt class="text-gray-500">Description</dt><dd>{fromMaybe "—" entry.description}</dd></div>
<div><dt class="text-gray-500">Owner</dt><dd>{maybe "Framework (cross-domain)" (.name) mOwner}</dd></div>
<div><dt class="text-gray-500">Replaced by</dt><dd>{fromMaybe "—" entry.deprecatedInFavourOf}</dd></div>
</dl>
<div class="mt-6 flex gap-2">
<a href={EditEventTypeAction { eventTypeRegistryId = entry.id }}
<a href={EditEventTypeAction (entry.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">Edit</a>
</div>
</div>
@@ -96,20 +97,10 @@ typeForm :: EventTypeRegistry -> [Hub] -> Bool -> Html
typeForm entry hubs isNew = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-6 max-w-lg">
<div class="space-y-4">
{if isNew then [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(permanent, lowercase-underscored)</span></label>
{(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
|] else [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(immutable)</span></label>
<p class="font-mono text-sm bg-gray-50 border border-gray-200 rounded px-3 py-2">{entry.name}</p>
</div>
|]}
{renderNameField isNew entry.name}
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Label</label>
{(textField #label) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
{(textField #label_) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Description <span class="text-gray-400 text-xs">(optional)</span></label>
@@ -145,7 +136,21 @@ instance View EditEventTypeView where
<a href={EventTypeRegistryAction} class="text-sm text-gray-500 hover:text-gray-700">← Event Types</a>
</div>
<h1 class="text-xl font-semibold mb-6">Edit Event Type</h1>
<form method="POST" action={UpdateEventTypeAction { eventTypeRegistryId = entry.id }}>
<form method="POST" action={UpdateEventTypeAction (entry.id)}>
{typeForm entry hubs False}
</form>
|]
renderNameField :: Bool -> Text -> Html
renderNameField True _ = [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(permanent, lowercase-underscored)</span></label>
{(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
|]
renderNameField False name = [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(immutable)</span></label>
<p class="font-mono text-sm bg-gray-50 border border-gray-200 rounded px-3 py-2">{name}</p>
</div>
|]

41
Web/View/TypeRegistries/PolicyScopes.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data PolicyScopesView = PolicyScopesView { entries :: ![PolicyScopeRegistry], hubs :: ![Hub] }
data ShowPolicyScopeView = ShowPolicyScopeView { entry :: !PolicyScopeRegistry, mOwner :: !(Maybe Hub) }
@@ -59,12 +60,12 @@ renderRow :: [Hub] -> PolicyScopeRegistry -> Html
renderRow hubs e = [hsx|
<tr class="border-b border-gray-100 hover:bg-gray-50">
<td class="px-4 py-3 font-mono text-xs">{e.name}</td>
<td class="px-4 py-3">{e.label}</td>
<td class="px-4 py-3">{e.label_}</td>
<td class="px-4 py-3 text-gray-500">{hubName hubs e.ownerHubId}</td>
<td class="px-4 py-3">{statusBadge e.status}</td>
<td class="px-4 py-3 text-right text-xs">
<a href={ShowPolicyScopeAction { policyScopeRegistryId = e.id }} class="text-gray-500 hover:text-gray-700 mr-2">View</a>
<a href={EditPolicyScopeAction { policyScopeRegistryId = e.id }} class="text-gray-500 hover:text-gray-700">Edit</a>
<a href={ShowPolicyScopeAction (e.id)} class="text-gray-500 hover:text-gray-700 mr-2">View</a>
<a href={EditPolicyScopeAction (e.id)} class="text-gray-500 hover:text-gray-700">Edit</a>
</td>
</tr>
|]
@@ -80,13 +81,13 @@ instance View ShowPolicyScopeView where
{statusBadge entry.status}
</div>
<dl class="space-y-3 text-sm">
<div><dt class="text-gray-500">Label</dt><dd class="font-medium">{entry.label}</dd></div>
<div><dt class="text-gray-500">Label</dt><dd class="font-medium">{entry.label_}</dd></div>
<div><dt class="text-gray-500">Description</dt><dd>{fromMaybe "—" entry.description}</dd></div>
<div><dt class="text-gray-500">Owner</dt><dd>{maybe "Framework (cross-domain)" (.name) mOwner}</dd></div>
<div><dt class="text-gray-500">Replaced by</dt><dd>{fromMaybe "—" entry.deprecatedInFavourOf}</dd></div>
</dl>
<div class="mt-6">
<a href={EditPolicyScopeAction { policyScopeRegistryId = entry.id }}
<a href={EditPolicyScopeAction (entry.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">Edit</a>
</div>
</div>
@@ -96,20 +97,10 @@ typeForm :: PolicyScopeRegistry -> [Hub] -> Bool -> Html
typeForm entry hubs isNew = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-6 max-w-lg">
<div class="space-y-4">
{if isNew then [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(permanent, lowercase-hyphenated)</span></label>
{(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
|] else [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(immutable)</span></label>
<p class="font-mono text-sm bg-gray-50 border border-gray-200 rounded px-3 py-2">{entry.name}</p>
</div>
|]}
{renderNameField isNew entry.name}
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Label</label>
{(textField #label) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
{(textField #label_) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Description <span class="text-gray-400 text-xs">(optional)</span></label>
@@ -145,7 +136,21 @@ instance View EditPolicyScopeView where
<a href={PolicyScopeRegistryAction} class="text-sm text-gray-500 hover:text-gray-700">← Policy Scopes</a>
</div>
<h1 class="text-xl font-semibold mb-6">Edit Policy Scope</h1>
<form method="POST" action={UpdatePolicyScopeAction { policyScopeRegistryId = entry.id }}>
<form method="POST" action={UpdatePolicyScopeAction (entry.id)}>
{typeForm entry hubs False}
</form>
|]
renderNameField :: Bool -> Text -> Html
renderNameField True _ = [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(permanent, lowercase-hyphenated)</span></label>
{(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
|]
renderNameField False name = [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(immutable)</span></label>
<p class="font-mono text-sm bg-gray-50 border border-gray-200 rounded px-3 py-2">{name}</p>
</div>
|]

58
Web/View/TypeRegistries/WidgetTypes.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data WidgetTypesView = WidgetTypesView { entries :: ![WidgetTypeRegistry], hubs :: ![Hub] }
data ShowWidgetTypeView = ShowWidgetTypeView { entry :: !WidgetTypeRegistry, mOwner :: !(Maybe Hub) }
@@ -59,12 +60,12 @@ renderRow :: [Hub] -> WidgetTypeRegistry -> Html
renderRow hubs e = [hsx|
<tr class="border-b border-gray-100 hover:bg-gray-50">
<td class="px-4 py-3 font-mono text-xs">{e.name}</td>
<td class="px-4 py-3">{e.label}</td>
<td class="px-4 py-3">{e.label_}</td>
<td class="px-4 py-3 text-gray-500">{hubName hubs e.ownerHubId}</td>
<td class="px-4 py-3">{statusBadge e.status}</td>
<td class="px-4 py-3 text-right text-xs">
<a href={ShowWidgetTypeAction { widgetTypeRegistryId = e.id }} class="text-gray-500 hover:text-gray-700 mr-2">View</a>
<a href={EditWidgetTypeAction { widgetTypeRegistryId = e.id }} class="text-gray-500 hover:text-gray-700">Edit</a>
<a href={ShowWidgetTypeAction (e.id)} class="text-gray-500 hover:text-gray-700 mr-2">View</a>
<a href={EditWidgetTypeAction (e.id)} class="text-gray-500 hover:text-gray-700">Edit</a>
</td>
</tr>
|]
@@ -80,22 +81,15 @@ instance View ShowWidgetTypeView where
{statusBadge entry.status}
</div>
<dl class="space-y-3 text-sm">
<div><dt class="text-gray-500">Label</dt><dd class="font-medium">{entry.label}</dd></div>
<div><dt class="text-gray-500">Label</dt><dd class="font-medium">{entry.label_}</dd></div>
<div><dt class="text-gray-500">Description</dt><dd>{fromMaybe "—" entry.description}</dd></div>
<div><dt class="text-gray-500">Owner</dt><dd>{maybe "Framework (cross-domain)" (.name) mOwner}</dd></div>
<div><dt class="text-gray-500">Replaced by</dt><dd>{fromMaybe "—" entry.deprecatedInFavourOf}</dd></div>
</dl>
<div class="mt-6 flex gap-2">
<a href={EditWidgetTypeAction { widgetTypeRegistryId = entry.id }}
<a href={EditWidgetTypeAction (entry.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">Edit</a>
{if entry.status == "active"
then [hsx|
<form method="POST" action={DeprecateWidgetTypeAction { widgetTypeRegistryId = entry.id }}>
<input type="hidden" name="deprecated_in_favour_of" value="" placeholder="replacement name" />
<button type="submit" class="text-sm border border-amber-300 text-amber-700 px-3 py-1.5 rounded hover:bg-amber-50">Deprecate</button>
</form>
|]
else mempty}
{if entry.status == "active" then renderDeprecateForm entry.id else mempty}
</div>
</div>
|]
@@ -104,20 +98,10 @@ typeForm :: WidgetTypeRegistry -> [Hub] -> Bool -> Html
typeForm entry hubs isNew = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-6 max-w-lg">
<div class="space-y-4">
{if isNew then [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(permanent identifier, lowercase-hyphenated)</span></label>
{(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
|] else [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(immutable)</span></label>
<p class="font-mono text-sm bg-gray-50 border border-gray-200 rounded px-3 py-2">{entry.name}</p>
</div>
|]}
{renderNameField isNew entry.name}
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Label</label>
{(textField #label) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
{(textField #label_) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Description <span class="text-gray-400 text-xs">(optional)</span></label>
@@ -153,7 +137,29 @@ instance View EditWidgetTypeView where
<a href={WidgetTypeRegistryAction} class="text-sm text-gray-500 hover:text-gray-700">← Widget Types</a>
</div>
<h1 class="text-xl font-semibold mb-6">Edit Widget Type</h1>
<form method="POST" action={UpdateWidgetTypeAction { widgetTypeRegistryId = entry.id }}>
<form method="POST" action={UpdateWidgetTypeAction (entry.id)}>
{typeForm entry hubs False}
</form>
|]
renderNameField :: Bool -> Text -> Html
renderNameField True _ = [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(permanent identifier, lowercase-hyphenated)</span></label>
{(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
</div>
|]
renderNameField False name = [hsx|
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name <span class="text-gray-400 text-xs">(immutable)</span></label>
<p class="font-mono text-sm bg-gray-50 border border-gray-200 rounded px-3 py-2">{name}</p>
</div>
|]
renderDeprecateForm :: Id WidgetTypeRegistry -> Html
renderDeprecateForm entryId = [hsx|
<form method="POST" action={DeprecateWidgetTypeAction (entryId)}>
<input type="hidden" name="deprecated_in_favour_of" value="" placeholder="replacement name" />
<button type="submit" class="text-sm border border-amber-300 text-amber-700 px-3 py-1.5 rounded hover:bg-amber-50">Deprecate</button>
</form>
|]

1
Web/View/WebhookSubscriptions/New.hs
View File

@@ -4,6 +4,7 @@ import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
webhookTopics :: [Text]
webhookTopics =

Some files were not shown because too many files have changed in this diff Show More