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

fix(WP-0014/A2): close remaining pure-param and structural compilation errors

Browse Source 
Convert all remaining `<- paramOrNothing / param / paramOrDefault /
currentUserOrNothing` monadic binds to `let` — these functions are pure
(ImplicitParams-based) in IHP v1.5, so `<-` is a type error in an IO
do-block.

Controllers fixed:
  AgentDelegations, AiGovernancePolicies, Annotations, ApiConsumers,
  CollectiveProposals, DecisionRecords, DeploymentRecords,
  HubCapabilityManifests, HubRoutingRules, InstitutionalKnowledge,
  OutcomeCorrelations, RequirementCandidates, TypeRegistries,
  WebhookSubscriptions, Widgets,
  Api/V2/{Annotations,InteractionEvents,Token}

WebhookSubscriptions: remove orphaned `Right () ->` case arm that was
left inside a bare `unless` block (structural parse error).

Also carries forward all in-progress fixes from the working tree:
  helpers (AgentBridge, ApiRateLimit, BottleneckDetector,
            CrossHubPropagation, FrictionScore),
  views (CanSelect instances, HSX lambda extraction, formFor wrappers),
  env/build (envrc GHCi perms, flake.nix Tailwind + GHC resource limits,
             static/app.css additional Tailwind output).

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
Bernd Worsch
2026-04-10 01:14:08 +00:00
parent 5510ae22da
commit ce42607fca
85 changed files with 584 additions and 397 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -1,6 +1,6 @@
module Web.View.AdaptiveThresholds.Index where
import IHP.ViewPrelude
import Web.View.Prelude
import Data.Time (diffUTCTime)
data IndexView = IndexView

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

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

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

@@ -1,6 +1,6 @@
module Web.View.AgentDelegations.Show where
import IHP.ViewPrelude
import Web.View.Prelude
import Web.View.AgentDelegations.Index (statusBadge)
import Data.Aeson (Value)

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

@@ -1,6 +1,6 @@
module Web.View.AgentRegistrations.Edit where
import IHP.ViewPrelude
import Web.View.Prelude
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 IHP.ViewPrelude
import Web.View.Prelude
data IndexView = IndexView
{ agents :: ![AgentRegistration]

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

@@ -1,6 +1,6 @@
module Web.View.AgentRegistrations.New where
import IHP.ViewPrelude
import Web.View.Prelude
data NewView = NewView
{ agent :: !AgentRegistration

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 IHP.ViewPrelude
import Web.View.Prelude
import Web.View.AgentRegistrations.Show (performancePanel)

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

@@ -1,6 +1,6 @@
module Web.View.AgentRegistrations.Show where
import IHP.ViewPrelude
import Web.View.Prelude
import Web.View.AgentRegistrations.Index (trustBadge, statusBadge)
import Text.Printf (printf)

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

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

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

@@ -1,6 +1,6 @@
module Web.View.AiGovernancePolicies.New where
import IHP.ViewPrelude
import Web.View.Prelude
data NewView = NewView
{ policy :: !AiGovernancePolicy
@@ -34,33 +34,36 @@ instance View NewView where
html NewView { .. } = [hsx|
<div class="p-6 max-w-xl">
<h1 class="text-2xl font-bold text-gray-900 mb-6">Add AI Governance Policy</h1>
{formFor policy [hsx|
<div class="space-y-4">
<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 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 renderAgentOption}
</select>
</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 renderActionOption}
</div>
</div>
<div class="flex gap-3 pt-2">
{submitButton { label = "Create Policy" }}
<a href={AiGovernancePoliciesAction}
class="px-4 py-2 bg-gray-100 hover:bg-gray-200 rounded-md text-sm">Cancel</a>
</div>
</div>
|]}
{renderForm policy hubs agents}
</div>
|]
renderForm :: AiGovernancePolicy -> [Hub] -> [AgentRegistration] -> Html
renderForm policy hubs agents = formFor policy [hsx|
<div class="space-y-4">
<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 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 renderAgentOption}
</select>
</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 renderActionOption}
</div>
</div>
<div class="flex gap-3 pt-2">
{submitButton { label = "Create Policy" }}
<a href={AiGovernancePoliciesAction}
class="px-4 py-2 bg-gray-100 hover:bg-gray-200 rounded-md text-sm">Cancel</a>
</div>
</div>
|]

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

@@ -5,6 +5,7 @@ import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Coerce (coerce)
data IndexView = IndexView
{ widget :: !Widget
@@ -14,7 +15,7 @@ data IndexView = IndexView
instance View IndexView where
html IndexView { .. } =
let rootAnnotations = filter (\a -> isNothing a.parentId) annotations
childrenOf parent = filter (\a -> a.parentId == Just parent.id) annotations
childrenOf parent = filter (\a -> a.parentId == Just (coerce parent.id :: UUID)) 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>

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

@@ -24,7 +24,7 @@ instance View EditView where
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Description</label>
<textarea name="description" class="border rounded px-3 py-2 text-sm w-full" rows="3">{maybe "" id consumer.description}</textarea>
<textarea name="description" class="border rounded px-3 py-2 text-sm w-full" rows="3">{fromMaybe "" consumer.description}</textarea>
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Linked Hub Manifest (optional)</label>

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

@@ -23,7 +23,7 @@ instance View NewView where
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Description</label>
<textarea name="description" class="border rounded px-3 py-2 text-sm w-full" rows="3">{maybe "" id consumer.description}</textarea>
<textarea name="description" class="border rounded px-3 py-2 text-sm w-full" rows="3">{fromMaybe "" consumer.description}</textarea>
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Linked Hub Manifest (optional)</label>

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

@@ -5,6 +5,7 @@ import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Coerce (coerce)
data ShowView = ShowView
{ record :: !ArchiveRecord

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

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

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

@@ -1,6 +1,6 @@
module Web.View.CollectiveProposals.Show where
import IHP.ViewPrelude
import Web.View.Prelude
import Web.View.CollectiveProposals.Index (consensusBadge)
import Data.Aeson (Value)

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

@@ -27,7 +27,7 @@ instance View NewView where
</div>
|]
renderForm :: DecisionRecord -> [Requirement] -> [RequirementCandidate] -> [User] -> action -> Html
renderForm :: HasPath action => 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">
<div>

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

@@ -259,7 +259,7 @@ renderEvalSummary ev = [hsx|
|]
starsFor :: Int16 -> Text
starsFor n = pack (Prelude.replicate (fromIntegral n) '★') <> pack (Prelude.replicate (5 - fromIntegral n) '☆')
starsFor n = pack (replicate (fromIntegral n) '★') <> pack (replicate (5 - fromIntegral n) '☆')
scoreClass :: Int16 -> Text
scoreClass n

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

@@ -84,7 +84,7 @@ renderScoreBadge score = [hsx|
|]
starsFor :: Int16 -> Text
starsFor n = pack (Prelude.replicate (fromIntegral n) '★') <> pack (Prelude.replicate (5 - fromIntegral n) '☆')
starsFor n = pack (replicate (fromIntegral n) '★') <> pack (replicate (5 - fromIntegral n) '☆')
scoreClass :: Int16 -> Text
scoreClass n

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

@@ -329,7 +329,7 @@ scoreClass n
| otherwise = "bg-green-100 text-green-800"
starsFor :: Int16 -> Text
starsFor n = pack (Prelude.replicate (fromIntegral n) '★') <> pack (Prelude.replicate (5 - fromIntegral n) '☆')
starsFor n = pack (replicate (fromIntegral n) '★') <> pack (replicate (5 - fromIntegral n) '☆')
userName :: [User] -> Maybe (Id User) -> Text
userName _ Nothing = "—"

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

@@ -184,7 +184,7 @@ instance View FederatedGovernanceDashboardView where
-- ── Panel 5: Archive activity ─────────────────────────────────────
archiveByType = List.sortBy (\a b -> compare (fst a) (fst b))
$ map (\grp -> ((head grp).subjectType, length grp))
$ map (\grp -> (maybe "" (.subjectType) (head grp), length grp))
$ List.groupBy (\a b -> a.subjectType == b.subjectType)
$ List.sortBy (\a b -> compare a.subjectType b.subjectType) recentArchives

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

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

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

@@ -1,6 +1,6 @@
module Web.View.InstitutionalKnowledge.Show where
import IHP.ViewPrelude
import Web.View.Prelude
data ShowView = ShowView
{ entry :: !InstitutionalKnowledgeEntry

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

@@ -1,6 +1,6 @@
module Web.View.LearningDashboard.Show where
import IHP.ViewPrelude
import Web.View.Prelude
import Data.Time (diffUTCTime, getCurrentTime, nominalDay)
data ShowView = ShowView

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

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

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

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

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

@@ -1,6 +1,6 @@
module Web.View.ModelRoutingPolicies.New where
import IHP.ViewPrelude
import Web.View.Prelude
data NewView = NewView
{ policy :: !ModelRoutingPolicy
@@ -21,37 +21,40 @@ instance View NewView where
html NewView { .. } = [hsx|
<div class="p-6 max-w-xl">
<h1 class="text-2xl font-bold text-gray-900 mb-6">Add Routing Policy</h1>
{formFor policy [hsx|
<div class="space-y-4">
<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 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 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 renderAgentOption}
</select>
</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}
class="px-4 py-2 bg-gray-100 hover:bg-gray-200 rounded-md text-sm">Cancel</a>
</div>
</div>
|]}
{renderForm policy hubs agents}
</div>
|]
renderForm :: ModelRoutingPolicy -> [Hub] -> [AgentRegistration] -> Html
renderForm policy hubs agents = formFor policy [hsx|
<div class="space-y-4">
<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 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 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 renderAgentOption}
</select>
</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}
class="px-4 py-2 bg-gray-100 hover:bg-gray-200 rounded-md text-sm">Cancel</a>
</div>
</div>
|]
renderHubOption :: Hub -> Html
renderHubOption h = [hsx|<option value={show h.id}>{h.name}</option>|]

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

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

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

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

13
Web/View/Prelude.hs
View File

@@ -10,3 +10,16 @@ import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
-- | Allow [(Text, Text)] option lists in selectField/radioField.
-- The first element is the display label; the second is the stored value.
instance CanSelect (Text, Text) where
type SelectValue (Text, Text) = Text
selectValue (_, v) = v
selectLabel (l, _) = l
-- | Allow [(Text, Id' tag)] option lists (e.g. hub selectors) in selectField.
instance CanSelect (Text, Id' tag) where
type SelectValue (Text, Id' tag) = Id' tag
selectValue (_, v) = v
selectLabel (l, _) = l

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

@@ -93,7 +93,25 @@ instance View ShowAnnotationCategoryView where
</div>
|]
typeForm :: AnnotationCategoryRegistry -> [Hub] -> Bool -> Html
instance View NewAnnotationCategoryView where
html NewAnnotationCategoryView { .. } = [hsx|
<div class="mb-4">
<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">Register Annotation Category</h1>
{formFor entry (typeForm entry hubs True)}
|]
instance View EditAnnotationCategoryView where
html EditAnnotationCategoryView { .. } = [hsx|
<div class="mb-4">
<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>
{formFor entry (typeForm entry hubs False)}
|]
typeForm :: (?context :: ControllerContext, ?formContext :: FormContext AnnotationCategoryRegistry) => 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">
@@ -119,29 +137,7 @@ typeForm entry hubs isNew = [hsx|
</div>
|]
instance View NewAnnotationCategoryView where
html NewAnnotationCategoryView { .. } = [hsx|
<div class="mb-4">
<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">Register Annotation Category</h1>
<form method="POST" action={CreateAnnotationCategoryAction}>
{typeForm entry hubs True}
</form>
|]
instance View EditAnnotationCategoryView where
html EditAnnotationCategoryView { .. } = [hsx|
<div class="mb-4">
<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 (entry.id)}>
{typeForm entry hubs False}
</form>
|]
renderNameField :: Bool -> Text -> Html
renderNameField :: (?context :: ControllerContext, ?formContext :: FormContext AnnotationCategoryRegistry) => 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>

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

@@ -93,7 +93,25 @@ instance View ShowEventTypeView where
</div>
|]
typeForm :: EventTypeRegistry -> [Hub] -> Bool -> Html
instance View NewEventTypeView where
html NewEventTypeView { .. } = [hsx|
<div class="mb-4">
<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">Register Event Type</h1>
{formFor entry (typeForm entry hubs True)}
|]
instance View EditEventTypeView where
html EditEventTypeView { .. } = [hsx|
<div class="mb-4">
<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>
{formFor entry (typeForm entry hubs False)}
|]
typeForm :: (?context :: ControllerContext, ?formContext :: FormContext EventTypeRegistry) => 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">
@@ -119,29 +137,7 @@ typeForm entry hubs isNew = [hsx|
</div>
|]
instance View NewEventTypeView where
html NewEventTypeView { .. } = [hsx|
<div class="mb-4">
<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">Register Event Type</h1>
<form method="POST" action={CreateEventTypeAction}>
{typeForm entry hubs True}
</form>
|]
instance View EditEventTypeView where
html EditEventTypeView { .. } = [hsx|
<div class="mb-4">
<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 (entry.id)}>
{typeForm entry hubs False}
</form>
|]
renderNameField :: Bool -> Text -> Html
renderNameField :: (?context :: ControllerContext, ?formContext :: FormContext EventTypeRegistry) => 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>

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

@@ -93,7 +93,25 @@ instance View ShowPolicyScopeView where
</div>
|]
typeForm :: PolicyScopeRegistry -> [Hub] -> Bool -> Html
instance View NewPolicyScopeView where
html NewPolicyScopeView { .. } = [hsx|
<div class="mb-4">
<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">Register Policy Scope</h1>
{formFor entry (typeForm entry hubs True)}
|]
instance View EditPolicyScopeView where
html EditPolicyScopeView { .. } = [hsx|
<div class="mb-4">
<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>
{formFor entry (typeForm entry hubs False)}
|]
typeForm :: (?context :: ControllerContext, ?formContext :: FormContext PolicyScopeRegistry) => 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">
@@ -119,29 +137,7 @@ typeForm entry hubs isNew = [hsx|
</div>
|]
instance View NewPolicyScopeView where
html NewPolicyScopeView { .. } = [hsx|
<div class="mb-4">
<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">Register Policy Scope</h1>
<form method="POST" action={CreatePolicyScopeAction}>
{typeForm entry hubs True}
</form>
|]
instance View EditPolicyScopeView where
html EditPolicyScopeView { .. } = [hsx|
<div class="mb-4">
<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 (entry.id)}>
{typeForm entry hubs False}
</form>
|]
renderNameField :: Bool -> Text -> Html
renderNameField :: (?context :: ControllerContext, ?formContext :: FormContext PolicyScopeRegistry) => 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>

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

@@ -94,7 +94,25 @@ instance View ShowWidgetTypeView where
</div>
|]
typeForm :: WidgetTypeRegistry -> [Hub] -> Bool -> Html
instance View NewWidgetTypeView where
html NewWidgetTypeView { .. } = [hsx|
<div class="mb-4">
<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">Register Widget Type</h1>
{formFor entry (typeForm entry hubs True)}
|]
instance View EditWidgetTypeView where
html EditWidgetTypeView { .. } = [hsx|
<div class="mb-4">
<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>
{formFor entry (typeForm entry hubs False)}
|]
typeForm :: (?context :: ControllerContext, ?formContext :: FormContext WidgetTypeRegistry) => 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">
@@ -120,29 +138,7 @@ typeForm entry hubs isNew = [hsx|
</div>
|]
instance View NewWidgetTypeView where
html NewWidgetTypeView { .. } = [hsx|
<div class="mb-4">
<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">Register Widget Type</h1>
<form method="POST" action={CreateWidgetTypeAction}>
{typeForm entry hubs True}
</form>
|]
instance View EditWidgetTypeView where
html EditWidgetTypeView { .. } = [hsx|
<div class="mb-4">
<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 (entry.id)}>
{typeForm entry hubs False}
</form>
|]
renderNameField :: Bool -> Text -> Html
renderNameField :: (?context :: ControllerContext, ?formContext :: FormContext WidgetTypeRegistry) => 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>

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

@@ -27,7 +27,7 @@ instance View NewView where
<h1 class="text-2xl font-semibold mb-2">New Webhook Subscription</h1>
<p class="text-sm text-gray-500 mb-6">Consumer: <strong>{consumer.name}</strong></p>
<form method="POST" action={CreateWebhookSubscriptionAction} class="space-y-4">
{hiddenField #id}
<input type="hidden" name="id" value={show subscription.id} />
<input type="hidden" name="apiConsumerId" value={show consumer.id} />
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Event Topic *</label>
@@ -37,7 +37,8 @@ instance View NewView where
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Target URL *</label>
{textField #targetUrl}
<input type="text" name="targetUrl" value={subscription.targetUrl}
class="border rounded px-3 py-2 text-sm w-full" required />
<p class="text-xs text-gray-400 mt-1">Must be HTTPS. IHF will POST JSON payloads with X-IHF-Signature header.</p>
</div>
<div class="pt-2 flex gap-3">

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

@@ -85,8 +85,8 @@ renderForm spec envelopes reportings = formFor spec [hsx|
</div>
|]
renderEnvelopeOption :: WidgetEnvelopeContract -> Html
renderEnvelopeOption :: EnvelopeEmissionContract -> Html
renderEnvelopeOption e = [hsx|<option value={tshow e.id}>v{e.contractVersion}</option>|]
renderReportingOption :: WidgetReportingContract -> Html
renderReportingOption :: InteractionReportingContract -> Html
renderReportingOption r = [hsx|<option value={tshow r.id}>v{r.contractVersion}</option>|]

11
Web/View/WidgetOwnerships/Edit.hs
View File

@@ -22,7 +22,13 @@ instance View EditView where
renderForm :: WidgetOwnership -> [Hub] -> Html
renderForm ownership hubs = formFor ownership [hsx|
{(selectField #stewardHubId hubs){ fieldLabel = "Steward Hub (optional)" }}
<div>
<label class="ihp-form-label">Steward Hub (optional)</label>
<select name="stewardHubId" class="ihp-form-field">
<option value="">— None —</option>
{forEach hubs renderHubOption}
</select>
</div>
{(selectField #ownershipType ownershipTypes){ fieldLabel = "Ownership Type" }}
{dateTimeField #effectiveUntil}
{textareaField #notes}
@@ -31,3 +37,6 @@ renderForm ownership hubs = formFor ownership [hsx|
where
ownershipTypes :: [(Text, Text)]
ownershipTypes = [("local","local"), ("delegated","delegated"), ("global","global")]
renderHubOption :: Hub -> Html
renderHubOption h = [hsx|<option value={tshow h.id}>{h.name}</option>|]

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

@@ -24,7 +24,13 @@ renderForm :: WidgetOwnership -> [Widget] -> [Hub] -> Html
renderForm ownership widgets hubs = formFor ownership [hsx|
{(selectField #widgetId widgets) { fieldLabel = "Widget" }}
{(selectField #ownerHubId hubs) { fieldLabel = "Owner Hub" }}
{(selectField #stewardHubId hubs){ fieldLabel = "Steward Hub (optional)" }}
<div>
<label class="ihp-form-label">Steward Hub (optional)</label>
<select name="stewardHubId" class="ihp-form-field">
<option value="">— None —</option>
{forEach hubs renderHubOption}
</select>
</div>
{(selectField #ownershipType ownershipTypes){ fieldLabel = "Ownership Type" }}
{dateTimeField #effectiveFrom}
{dateTimeField #effectiveUntil}
@@ -34,3 +40,6 @@ renderForm ownership widgets hubs = formFor ownership [hsx|
where
ownershipTypes :: [(Text, Text)]
ownershipTypes = [("local","local"), ("delegated","delegated"), ("global","global")]
renderHubOption :: Hub -> Html
renderHubOption h = [hsx|<option value={tshow h.id}>{h.name}</option>|]

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

@@ -23,7 +23,6 @@ instance View EditView where
<h1 class="text-2xl font-semibold mb-6">Edit Pattern</h1>
<form method="POST" action={UpdateWidgetPatternAction (pattern.id)}>
{csrfTokenFormField}
<div class="space-y-4 max-w-lg">
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name</label>

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

@@ -27,7 +27,6 @@ instance View NewView where
renderForm :: WidgetPattern -> [Hub] -> [(Text, Text)] -> Html
renderForm pattern hubs widgetTypes = [hsx|
<form method="POST" action={CreateWidgetPatternAction}>
{csrfTokenFormField}
<div class="space-y-4 max-w-lg">
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Name</label>

3
Web/View/WidgetPatterns/Show.hs
View File

@@ -139,14 +139,13 @@ renderPublishNewVersionForm True pid = [hsx|
<div class="border-t border-gray-200 pt-4">
<h2 class="text-base font-semibold mb-3">Publish New Version</h2>
<form method="POST" action={PublishNewVersionAction (pid)}>
{csrfTokenFormField}
<div class="mb-3">
<label class="block text-sm font-medium text-gray-700 mb-1">
Definition (JSON)
</label>
<textarea name="definition" rows="4"
class="w-full border border-gray-300 rounded px-3 py-2 text-sm font-mono"
placeholder='{"key": "value"}'></textarea>
placeholder="JSON definition"></textarea>
</div>
<div class="mb-3">
<label class="block text-sm font-medium text-gray-700 mb-1">Changelog</label>

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

@@ -33,24 +33,7 @@ instance View ShowView where
{if isRegressed then renderRegressionBanner else mempty}
{widgetEnvelope widget [hsx|
<div class="flex items-center justify-between mb-4">
<div>
<h1 class="text-2xl font-semibold">{widget.name}</h1>
<p class="text-sm text-gray-500 mt-0.5">
{widget.widgetType}
<span class="ml-2 text-xs bg-gray-100 px-1.5 py-0.5 rounded">{widget.policyScope}</span>
<span class="ml-2 text-xs bg-green-100 text-green-700 px-1.5 py-0.5 rounded">{widget.status}</span>
<span class="ml-2 text-xs text-gray-400">v{show widget.version}</span>
{renderAdapterBadge mAdapterSpec}
</p>
</div>
<a href={EditWidgetAction (widget.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Edit
</a>
</div>
|]}
{widgetEnvelope widget widgetHeader}
<div class="grid grid-cols-3 gap-4 mb-8 mt-6">
<div class="bg-white rounded-lg border border-gray-200 p-4">
@@ -132,14 +115,32 @@ instance View ShowView where
</div>
</section>
|]
where
rootAnnotations = filter (\a -> isNothing a.parentId) annotations
childrenOf parent = filter (\a -> a.parentId == Just parent.id) annotations
categoryBreakdown =
[ (cat, length (filter (\a -> a.category == cat) annotations))
| cat <- ["friction","defect","wish","policy_concern","doc_gap","trust","other"]
, any (\a -> a.category == cat) annotations
]
where
widgetHeader = [hsx|
<div class="flex items-center justify-between mb-4">
<div>
<h1 class="text-2xl font-semibold">{widget.name}</h1>
<p class="text-sm text-gray-500 mt-0.5">
{widget.widgetType}
<span class="ml-2 text-xs bg-gray-100 px-1.5 py-0.5 rounded">{widget.policyScope}</span>
<span class="ml-2 text-xs bg-green-100 text-green-700 px-1.5 py-0.5 rounded">{widget.status}</span>
<span class="ml-2 text-xs text-gray-400">v{show widget.version}</span>
{renderAdapterBadge mAdapterSpec}
</p>
</div>
<a href={EditWidgetAction (widget.id)}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Edit
</a>
</div>
|]
rootAnnotations = filter (\a -> isNothing a.parentId) annotations
childrenOf parent = filter (\a -> a.parentId == Just parent.id) annotations
categoryBreakdown =
[ (cat, length (filter (\a -> a.category == cat) annotations))
| cat <- ["friction","defect","wish","policy_concern","doc_gap","trust","other"]
, any (\a -> a.category == cat) annotations
]
renderAnnotation :: (Annotation -> [Annotation]) -> Annotation -> Html
renderAnnotation childrenOf a = [hsx|