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

feat(P2+P3): IHF Phase 2 complete; register Phase 3 workplan

Browse Source 
Phase 2 — Structured Feedback and Triage (IHUB-WP-0002):
- Schema: annotation_threads, requirement_candidates, triage_states,
  reviewer_assignments; annotations extended with severity + thread_id
- AnnotationThreadsController: create threads, assign annotations
- RequirementCandidatesController: CRUD, escalation, triage lifecycle,
  reviewer assignment, my-queue
- Annotation severity (low/medium/high/critical) with Tailwind color cues
- TriageDashboardAction on HubsController with autoRefresh
- Integration tests (T01–T09), SCOPE.md updated, docs/phase2-summary.md

Phase 3 — Governance and Decision Linkage (IHUB-WP-0003):
- Workplan registered: 9 tasks, State Hub workstream 5f201ee3

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
Bernd Worsch
2026-03-28 23:37:34 +00:00
parent cfcf4c81f7
commit 840b0e5c7b
25 changed files with 2136 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files

53
Application/Migration/1743120000-ihf-phase2-feedback-triage.sql Normal file
View File

@@ -0,0 +1,53 @@
-- IHF Phase 2 Migration: Structured Feedback and Triage
-- Introduces: annotation_threads, requirement_candidates, triage_states, reviewer_assignments
-- Extends: annotations (severity, thread_id)
-- annotation_threads must be created BEFORE altering annotations (FK reference)
CREATE TABLE annotation_threads (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
widget_id UUID NOT NULL REFERENCES widgets(id) ON DELETE CASCADE,
title TEXT NOT NULL,
description TEXT,
created_by UUID REFERENCES users(id),
created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
);
-- Extend annotations with severity and thread grouping
ALTER TABLE annotations ADD COLUMN severity TEXT NOT NULL DEFAULT 'medium';
ALTER TABLE annotations ADD COLUMN thread_id UUID REFERENCES annotation_threads(id) ON DELETE SET NULL;
CREATE TABLE requirement_candidates (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
title TEXT NOT NULL,
description TEXT NOT NULL,
source_widget_id UUID NOT NULL REFERENCES widgets(id) ON DELETE RESTRICT,
source_thread_id UUID REFERENCES annotation_threads(id) ON DELETE SET NULL,
source_annotation_id UUID REFERENCES annotations(id) ON DELETE SET NULL,
category TEXT NOT NULL DEFAULT 'friction',
status TEXT NOT NULL DEFAULT 'open',
created_by UUID REFERENCES users(id),
created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
);
CREATE INDEX requirement_candidates_widget_id_idx ON requirement_candidates (source_widget_id);
CREATE INDEX requirement_candidates_status_idx ON requirement_candidates (status);
CREATE TABLE triage_states (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
candidate_id UUID NOT NULL REFERENCES requirement_candidates(id) ON DELETE CASCADE,
status TEXT NOT NULL,
notes TEXT,
changed_by UUID REFERENCES users(id),
changed_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
);
CREATE INDEX triage_states_candidate_id_idx ON triage_states (candidate_id);
CREATE TABLE reviewer_assignments (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
candidate_id UUID NOT NULL REFERENCES requirement_candidates(id) ON DELETE CASCADE,
user_id UUID NOT NULL REFERENCES users(id) ON DELETE CASCADE,
assigned_by UUID REFERENCES users(id),
assigned_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL,
UNIQUE (candidate_id)
);

56
Application/Schema.sql
View File

@@ -1,6 +1,8 @@
-- IHF Phase 1 Schema
-- IHF Phase 1 + Phase 2 Schema
-- Hub, Widget, WidgetVersion, InteractionEvent, Annotation
-- Phase 2: AnnotationThread, RequirementCandidate, TriageState, ReviewerAssignment
-- See workplans/IHUB-WP-0001-ihf-phase1-minimal-interaction-core.md
-- See workplans/IHUB-WP-0002-ihf-phase2-structured-feedback-and-triage.md
CREATE EXTENSION IF NOT EXISTS "uuid-ossp";
@@ -79,13 +81,26 @@ CREATE TRIGGER interaction_events_no_delete
BEFORE DELETE ON interaction_events
FOR EACH ROW EXECUTE FUNCTION prevent_interaction_event_mutation();
-- Annotation threads — groups related annotations for triage (Phase 2)
CREATE TABLE annotation_threads (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
widget_id UUID NOT NULL REFERENCES widgets(id) ON DELETE CASCADE,
title TEXT NOT NULL,
description TEXT,
created_by UUID REFERENCES users(id),
created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
);
-- Annotations — structured commentary, also append-only by convention
-- Phase 2 additions: severity, thread_id
CREATE TABLE annotations (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
widget_id UUID NOT NULL REFERENCES widgets(id) ON DELETE CASCADE,
parent_id UUID REFERENCES annotations(id) ON DELETE CASCADE,
body TEXT NOT NULL,
category TEXT NOT NULL DEFAULT 'friction',
severity TEXT NOT NULL DEFAULT 'medium',
thread_id UUID REFERENCES annotation_threads(id) ON DELETE SET NULL,
actor_id UUID,
actor_type TEXT NOT NULL DEFAULT 'user',
widget_state_ref TEXT,
@@ -94,3 +109,42 @@ CREATE TABLE annotations (
);
CREATE INDEX annotations_widget_id_idx ON annotations (widget_id);
-- Requirement candidates — escalated from annotations/threads (Phase 2)
CREATE TABLE requirement_candidates (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
title TEXT NOT NULL,
description TEXT NOT NULL,
source_widget_id UUID NOT NULL REFERENCES widgets(id) ON DELETE RESTRICT,
source_thread_id UUID REFERENCES annotation_threads(id) ON DELETE SET NULL,
source_annotation_id UUID REFERENCES annotations(id) ON DELETE SET NULL,
category TEXT NOT NULL DEFAULT 'friction',
status TEXT NOT NULL DEFAULT 'open',
created_by UUID REFERENCES users(id),
created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
);
CREATE INDEX requirement_candidates_widget_id_idx ON requirement_candidates (source_widget_id);
CREATE INDEX requirement_candidates_status_idx ON requirement_candidates (status);
-- Triage state history — append-only audit trail of status transitions (Phase 2)
CREATE TABLE triage_states (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
candidate_id UUID NOT NULL REFERENCES requirement_candidates(id) ON DELETE CASCADE,
status TEXT NOT NULL,
notes TEXT,
changed_by UUID REFERENCES users(id),
changed_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
);
CREATE INDEX triage_states_candidate_id_idx ON triage_states (candidate_id);
-- Reviewer assignments — one reviewer per candidate (Phase 2)
CREATE TABLE reviewer_assignments (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
candidate_id UUID NOT NULL REFERENCES requirement_candidates(id) ON DELETE CASCADE,
user_id UUID NOT NULL REFERENCES users(id) ON DELETE CASCADE,
assigned_by UUID REFERENCES users(id),
assigned_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL,
UNIQUE (candidate_id)
);

8
SCOPE.md
View File

@@ -65,9 +65,9 @@ IHF treats every meaningful UI element as a **governed interaction artifact** ra
## Current State
- Status: Phase 1 complete — minimal interaction core implemented
- Implementation: Phase 0 complete (specification); Phase 1 complete (widget registry, event capture, annotations, hub dashboard, auth)
- Stability: core artifact model and schema are stable; API surface may evolve in Phase 2
- Status: Phase 2 complete — structured feedback and triage implemented
- Implementation: Phase 0 complete (specification); Phase 1 complete (widget registry, event capture, annotations, hub dashboard, auth); Phase 2 complete (annotation severity, annotation threads, requirement candidates, triage lifecycle, reviewer assignment, triage dashboard)
- Stability: core artifact model and schema are stable; Phase 2 data model (RequirementCandidate, TriageState, ReviewerAssignment) is additive and stable
- Usage: reference implementation running on IHP v1.5 + PostgreSQL; `devenv up` to start
---
@@ -125,4 +125,4 @@ keywords: [spec, artifact, traceability, widget, decision, outcome]
## Notes
Phase 0 (specification) and Phase 1 (Minimal Interaction Core) are complete. Phase 2 target: Structured Feedback and Triage — RequirementCandidate extraction, annotation clustering, DataSync for widget embeds. The spec is intentionally broader than the first implementation — IHP is the reference technology for Phase 1, but the framework is designed to survive UI technology changes (§12.7, §Phase 6).
Phase 0 (specification), Phase 1 (Minimal Interaction Core), and Phase 2 (Structured Feedback and Triage) are complete. Phase 3 target: Decision Records — linking accepted RequirementCandidates to governed decision records and implementation changes. The spec is intentionally broader than the first implementation — IHP is the reference technology for Phases 1–2, but the framework is designed to survive UI technology changes (§12.7, §Phase 6).

289
Test/Integration.hs
View File

@@ -160,3 +160,292 @@ main = do
|> validateField #body nonEmpty
isValid ann `shouldBe` False
deleteRecord hub
-- ----------------------------------------------------------------
-- Phase 2: Annotation severity
-- ----------------------------------------------------------------
describe "Annotation severity" do
it "defaults to medium severity" do
hub <- newRecord @Hub
|> set #slug "sev-hub" |> set #name "Sev Hub" |> set #domain "d"
|> createRecord
widget <- newRecord @Widget
|> set #hubId hub.id |> set #name "Sev Widget" |> set #widgetType "form"
|> createRecord
ann <- newRecord @Annotation
|> set #widgetId widget.id
|> set #body "Default severity test"
|> set #category "friction"
|> set #actorType "user"
|> createRecord
ann.severity `shouldBe` "medium"
deleteRecord hub
it "stores explicit severity" do
hub <- newRecord @Hub
|> set #slug "sev2-hub" |> set #name "Sev2 Hub" |> set #domain "d"
|> createRecord
widget <- newRecord @Widget
|> set #hubId hub.id |> set #name "Sev2 Widget" |> set #widgetType "form"
|> createRecord
ann <- newRecord @Annotation
|> set #widgetId widget.id
|> set #body "Critical issue"
|> set #category "defect"
|> set #severity "critical"
|> set #actorType "user"
|> createRecord
ann.severity `shouldBe` "critical"
deleteRecord hub
-- ----------------------------------------------------------------
-- Phase 2: AnnotationThread create + assign annotation
-- ----------------------------------------------------------------
describe "AnnotationThread" do
it "creates thread and assigns annotation" do
hub <- newRecord @Hub
|> set #slug "th-hub" |> set #name "Th Hub" |> set #domain "d"
|> createRecord
widget <- newRecord @Widget
|> set #hubId hub.id |> set #name "Th Widget" |> set #widgetType "panel"
|> createRecord
thread <- newRecord @AnnotationThread
|> set #widgetId widget.id
|> set #title "Login flow friction cluster"
|> set #description (Just "All friction annotations about login")
|> createRecord
ann <- newRecord @Annotation
|> set #widgetId widget.id
|> set #body "Login button is confusing"
|> set #category "friction"
|> set #actorType "user"
|> createRecord
-- Assign annotation to thread
ann |> set #threadId (Just thread.id) |> updateRecord
fetched <- fetch ann.id
fetched.threadId `shouldBe` Just thread.id
deleteRecord hub
-- ----------------------------------------------------------------
-- Phase 2: Escalation annotation → RequirementCandidate
-- ----------------------------------------------------------------
describe "Escalation: annotation → RequirementCandidate" do
it "creates candidate from annotation" do
hub <- newRecord @Hub
|> set #slug "esc-hub" |> set #name "Esc Hub" |> set #domain "d"
|> createRecord
widget <- newRecord @Widget
|> set #hubId hub.id |> set #name "Esc Widget" |> set #widgetType "form"
|> createRecord
ann <- newRecord @Annotation
|> set #widgetId widget.id
|> set #body "The submit button is invisible"
|> set #category "defect"
|> set #actorType "user"
|> createRecord
candidate <- newRecord @RequirementCandidate
|> set #title "The submit button is invisible"
|> set #description ann.body
|> set #sourceWidgetId widget.id
|> set #sourceAnnotationId (Just ann.id)
|> set #category ann.category
|> set #status "open"
|> createRecord
candidate.status `shouldBe` "open"
candidate.sourceAnnotationId `shouldBe` Just ann.id
deleteRecord hub
it "duplicate escalation: candidate already linked to annotation" do
hub <- newRecord @Hub
|> set #slug "dup-hub" |> set #name "Dup Hub" |> set #domain "d"
|> createRecord
widget <- newRecord @Widget
|> set #hubId hub.id |> set #name "Dup Widget" |> set #widgetType "form"
|> createRecord
ann <- newRecord @Annotation
|> set #widgetId widget.id
|> set #body "Duplicate escalation test"
|> set #category "friction"
|> set #actorType "user"
|> createRecord
_c1 <- newRecord @RequirementCandidate
|> set #title "First escalation"
|> set #description ann.body
|> set #sourceWidgetId widget.id
|> set #sourceAnnotationId (Just ann.id)
|> set #category ann.category
|> set #status "open"
|> createRecord
-- Second escalation attempt: query returns existing
existing <- query @RequirementCandidate
|> filterWhere (#sourceAnnotationId, Just ann.id)
|> fetchOneOrNothing
isJust existing `shouldBe` True
deleteRecord hub
-- ----------------------------------------------------------------
-- Phase 2: Triage lifecycle
-- ----------------------------------------------------------------
describe "Triage lifecycle" do
it "valid path: open → in_review → accepted" do
hub <- newRecord @Hub
|> set #slug "tri-hub" |> set #name "Tri Hub" |> set #domain "d"
|> createRecord
widget <- newRecord @Widget
|> set #hubId hub.id |> set #name "Tri Widget" |> set #widgetType "form"
|> createRecord
candidate <- newRecord @RequirementCandidate
|> set #title "Triage test candidate"
|> set #description "Testing triage lifecycle"
|> set #sourceWidgetId widget.id
|> set #category "friction"
|> set #status "open"
|> createRecord
-- Transition: open → in_review
newRecord @TriageState
|> set #candidateId candidate.id
|> set #status "in_review"
|> createRecord
candidate |> set #status "in_review" |> updateRecord
inReview <- fetch candidate.id
inReview.status `shouldBe` "in_review"
-- Transition: in_review → accepted
newRecord @TriageState
|> set #candidateId inReview.id
|> set #status "accepted"
|> createRecord
inReview |> set #status "accepted" |> updateRecord
accepted <- fetch candidate.id
accepted.status `shouldBe` "accepted"
-- Audit trail: 2 triage state rows
rows <- query @TriageState |> filterWhere (#candidateId, candidate.id) |> fetch
length rows `shouldBe` 2
deleteRecord hub
it "invalid transition is not allowed by controller logic" do
let allowedTransition from to = case (from, to) of
("open", "in_review") -> True
("in_review", "accepted") -> True
("in_review", "rejected") -> True
("in_review", "deferred") -> True
("deferred", "in_review") -> True
_ -> False
allowedTransition "open" "accepted" `shouldBe` False
allowedTransition "open" "rejected" `shouldBe` False
allowedTransition "accepted" "open" `shouldBe` False
-- ----------------------------------------------------------------
-- Phase 2: ReviewerAssignment
-- ----------------------------------------------------------------
describe "ReviewerAssignment" do
it "assigns and reassigns reviewer" do
hub <- newRecord @Hub
|> set #slug "rev-hub" |> set #name "Rev Hub" |> set #domain "d"
|> createRecord
widget <- newRecord @Widget
|> set #hubId hub.id |> set #name "Rev Widget" |> set #widgetType "form"
|> createRecord
candidate <- newRecord @RequirementCandidate
|> set #title "Reviewer test"
|> set #description "Testing reviewer assignment"
|> set #sourceWidgetId widget.id
|> set #category "friction"
|> set #status "open"
|> createRecord
user1 <- newRecord @User
|> set #email "reviewer1@example.com"
|> set #name "Reviewer One"
|> set #passwordHash "hash1"
|> createRecord
user2 <- newRecord @User
|> set #email "reviewer2@example.com"
|> set #name "Reviewer Two"
|> set #passwordHash "hash2"
|> createRecord
-- First assignment
ra <- newRecord @ReviewerAssignment
|> set #candidateId candidate.id
|> set #userId user1.id
|> createRecord
ra.userId `shouldBe` user1.id
-- Reassign (upsert: delete old, insert new)
deleteRecord ra
ra2 <- newRecord @ReviewerAssignment
|> set #candidateId candidate.id
|> set #userId user2.id
|> createRecord
ra2.userId `shouldBe` user2.id
-- Only one assignment remains
assignments <- query @ReviewerAssignment
|> filterWhere (#candidateId, candidate.id)
|> fetch
length assignments `shouldBe` 1
deleteRecord hub
deleteRecord user1
deleteRecord user2
it "my-queue filter: only returns assigned open/in_review candidates" do
hub <- newRecord @Hub
|> set #slug "q-hub" |> set #name "Q Hub" |> set #domain "d"
|> createRecord
widget <- newRecord @Widget
|> set #hubId hub.id |> set #name "Q Widget" |> set #widgetType "form"
|> createRecord
user <- newRecord @User
|> set #email "queue@example.com"
|> set #name "Queue User"
|> set #passwordHash "hash"
|> createRecord
c1 <- newRecord @RequirementCandidate
|> set #title "Assigned open" |> set #description "d"
|> set #sourceWidgetId widget.id |> set #category "friction"
|> set #status "open" |> createRecord
c2 <- newRecord @RequirementCandidate
|> set #title "Unassigned" |> set #description "d"
|> set #sourceWidgetId widget.id |> set #category "friction"
|> set #status "open" |> createRecord
newRecord @ReviewerAssignment
|> set #candidateId c1.id
|> set #userId user.id
|> createRecord
assignments <- query @ReviewerAssignment |> filterWhere (#userId, user.id) |> fetch
let assignedIds = map (.candidateId) assignments
assignedIds `shouldContain` [c1.id]
assignedIds `shouldNotContain` [c2.id]
deleteRecord hub
deleteRecord user
-- ----------------------------------------------------------------
-- Phase 2: Triage dashboard autoRefresh wrapper check
-- ----------------------------------------------------------------
describe "Triage dashboard" do
it "autoRefresh wrapper: TriageDashboardAction fetches hub + widgets + candidates" do
-- Structural test: verify the data fetching logic compiles and is accessible
-- (runtime autoRefresh test requires WebSocket — verified manually)
hub <- newRecord @Hub
|> set #slug "dash-hub" |> set #name "Dash Hub" |> set #domain "d"
|> createRecord
widget <- newRecord @Widget
|> set #hubId hub.id |> set #name "Dash Widget" |> set #widgetType "panel"
|> createRecord
candidate <- newRecord @RequirementCandidate
|> set #title "Dashboard candidate" |> set #description "d"
|> set #sourceWidgetId widget.id |> set #category "friction"
|> set #status "open" |> createRecord
-- Verify fetch path used by dashboard action
widgets <- query @Widget |> filterWhere (#hubId, hub.id) |> fetch
candidates <- query @RequirementCandidate
|> filterWhereIn (#sourceWidgetId, map (.id) widgets)
|> fetch
length widgets `shouldBe` 1
length candidates `shouldBe` 1
deleteRecord hub

65
Web/Controller/AnnotationThreads.hs Normal file
View File

@@ -0,0 +1,65 @@
module Web.Controller.AnnotationThreads where
import Web.Types
import Web.View.AnnotationThreads.Index
import Web.View.AnnotationThreads.New
import Web.View.AnnotationThreads.Show
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
instance Controller AnnotationThreadsController where
beforeAction = ensureIsUser
action WidgetAnnotationThreadsAction { widgetId } = do
widget <- fetch widgetId
threads <- query @AnnotationThread
|> filterWhere (#widgetId, widgetId)
|> orderByDesc #createdAt
|> fetch
-- Fetch annotation counts per thread
allAnnotations <- query @Annotation
|> filterWhere (#widgetId, widgetId)
|> fetch
render IndexView { widget, threads, allAnnotations }
action ShowAnnotationThreadAction { annotationThreadId } = do
thread <- fetch annotationThreadId
widget <- fetch thread.widgetId
annotations <- query @Annotation
|> filterWhere (#threadId, Just annotationThreadId)
|> orderByAsc #createdAt
|> fetch
render ShowView { widget, thread, annotations }
action NewAnnotationThreadAction { widgetId } = do
widget <- fetch widgetId
let thread = newRecord @AnnotationThread
render NewView { widget, thread }
action CreateAnnotationThreadAction { widgetId } = do
widget <- fetch widgetId
mUser <- currentUserOrNothing
let createdBy = fmap (.id) mUser
let thread = newRecord @AnnotationThread
thread
|> fill @'["title", "description"]
|> set #widgetId widgetId
|> set #createdBy (fmap (Id . unId) createdBy)
|> validateField #title nonEmpty
|> ifValid \case
Left thread -> render NewView { widget, thread }
Right thread -> do
createRecord thread
setSuccessMessage "Thread created"
redirectTo WidgetAnnotationThreadsAction { widgetId }
action AssignAnnotationToThreadAction { annotationId } = do
annotation <- fetch annotationId
threadId <- param @(Id AnnotationThread) "threadId"
annotation
|> set #threadId (Just threadId)
|> updateRecord
setSuccessMessage "Annotation added to thread"
redirectTo ShowAnnotationThreadAction { annotationThreadId = threadId }

44
Web/Controller/Annotations.hs
View File

@@ -3,6 +3,7 @@ module Web.Controller.Annotations where
import Web.Types
import Web.View.Annotations.Index
import Web.View.Annotations.New
import Web.View.Annotations.Show
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
@@ -10,6 +11,9 @@ import IHP.ControllerPrelude
validCategories :: [Text]
validCategories = ["friction", "defect", "wish", "policy_concern", "doc_gap", "trust", "other"]
validSeverities :: [Text]
validSeverities = ["low", "medium", "high", "critical"]
instance Controller AnnotationsController where
beforeAction = ensureIsUser
@@ -21,6 +25,15 @@ instance Controller AnnotationsController where
|> fetch
render IndexView { widget, annotations }
action ShowAnnotationAction { annotationId } = do
annotation <- fetch annotationId
widget <- fetch annotation.widgetId
-- Check if already escalated to a candidate
mCandidate <- query @RequirementCandidate
|> filterWhere (#sourceAnnotationId, Just annotationId)
|> fetchOneOrNothing
render ShowView { widget, annotation, mCandidate }
action NewAnnotationAction { widgetId } = do
widget <- fetch widgetId
let annotation = newRecord @Annotation
@@ -34,15 +47,44 @@ instance Controller AnnotationsController where
let annotation = newRecord @Annotation
annotation
|> fill @'["body", "category", "parentId", "widgetStateRef"]
|> fill @'["body", "category", "severity", "parentId", "widgetStateRef"]
|> set #widgetId widgetId
|> set #actorId (fmap (Id . unId) actorId)
|> set #actorType actorType
|> validateField #body nonEmpty
|> validateField #category (`elem` validCategories)
|> validateField #severity (`elem` validSeverities)
|> ifValid \case
Left annotation -> render NewView { widget, annotation }
Right annotation -> do
createRecord annotation
setSuccessMessage "Annotation added"
redirectTo WidgetAnnotationsAction { widgetId }
action EscalateAnnotationAction { annotationId } = do
annotation <- fetch annotationId
mUser <- currentUserOrNothing
let createdBy = fmap (.id) mUser
-- Idempotent: check if already escalated
existing <- query @RequirementCandidate
|> filterWhere (#sourceAnnotationId, Just annotationId)
|> fetchOneOrNothing
case existing of
Just candidate ->
redirectTo ShowRequirementCandidateAction { requirementCandidateId = candidate.id }
Nothing -> do
let titleText = truncate80 annotation.body
candidate <- newRecord @RequirementCandidate
|> set #title titleText
|> set #description annotation.body
|> set #sourceWidgetId annotation.widgetId
|> set #sourceAnnotationId (Just annotationId)
|> set #category annotation.category
|> set #status "open"
|> set #createdBy (fmap (Id . unId) createdBy)
|> createRecord
setSuccessMessage "Escalated to requirement candidate"
redirectTo ShowRequirementCandidateAction { requirementCandidateId = candidate.id }
truncate80 :: Text -> Text
truncate80 t = if length t > 80 then take 80 t <> "…" else t

38
Web/Controller/Hubs.hs
View File

@@ -5,6 +5,7 @@ import Web.View.Hubs.Index
import Web.View.Hubs.Show
import Web.View.Hubs.New
import Web.View.Hubs.Edit
import Web.View.Hubs.TriageDashboard
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
@@ -72,3 +73,40 @@ instance Controller HubsController where
deleteRecord hub
setSuccessMessage "Hub deleted"
redirectTo HubsAction
action TriageDashboardAction { hubId } = autoRefresh do
hub <- fetch hubId
widgets <- query @Widget
|> filterWhere (#hubId, hubId)
|> fetch
let widgetIds = map (.id) widgets
-- All candidates for this hub's widgets
allCandidates <- query @RequirementCandidate
|> filterWhereIn (#sourceWidgetId, widgetIds)
|> orderByAsc #createdAt
|> fetch
-- Triage queue: open candidates, oldest first
let triageQueue = filter (\c -> c.status == "open") allCandidates
-- Recent escalations: last 20
recentEscalations <- query @RequirementCandidate
|> filterWhereIn (#sourceWidgetId, widgetIds)
|> orderByDesc #createdAt
|> limit 20
|> fetch
-- All annotations for category breakdown
allAnnotations <- query @Annotation
|> filterWhereIn (#widgetId, widgetIds)
|> fetch
render TriageDashboardView
{ hub
, widgets
, allCandidates
, triageQueue
, recentEscalations
, allAnnotations
}

180
Web/Controller/RequirementCandidates.hs Normal file
View File

@@ -0,0 +1,180 @@
module Web.Controller.RequirementCandidates where
import Web.Types
import Web.View.RequirementCandidates.Index
import Web.View.RequirementCandidates.Show
import Web.View.RequirementCandidates.New
import Web.View.RequirementCandidates.Edit
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
validStatuses :: [Text]
validStatuses = ["open", "in_review", "accepted", "rejected", "deferred"]
validCategories :: [Text]
validCategories = ["friction", "defect", "wish", "policy_concern", "doc_gap", "trust", "other"]
-- Allowed triage transitions
allowedTransition :: Text -> Text -> Bool
allowedTransition "open" "in_review" = True
allowedTransition "in_review" "accepted" = True
allowedTransition "in_review" "rejected" = True
allowedTransition "in_review" "deferred" = True
allowedTransition "deferred" "in_review" = True
allowedTransition _ _ = False
instance Controller RequirementCandidatesController where
beforeAction = ensureIsUser
action RequirementCandidatesAction = do
mStatusFilter <- paramOrNothing @Text "status"
candidates <- case mStatusFilter of
Nothing -> query @RequirementCandidate |> orderByDesc #createdAt |> fetch
Just s -> query @RequirementCandidate
|> filterWhere (#status, s)
|> orderByDesc #createdAt
|> fetch
-- Fetch reviewer assignments for display
assignments <- query @ReviewerAssignment |> fetch
users <- query @User |> fetch
widgets <- query @Widget |> fetch
render IndexView { candidates, assignments, users, widgets, mStatusFilter }
action ShowRequirementCandidateAction { requirementCandidateId } = do
candidate <- fetch requirementCandidateId
widget <- fetch candidate.sourceWidgetId
triageStates <- query @TriageState
|> filterWhere (#candidateId, requirementCandidateId)
|> orderByAsc #changedAt
|> fetch
mAssignment <- query @ReviewerAssignment
|> filterWhere (#candidateId, requirementCandidateId)
|> fetchOneOrNothing
users <- query @User |> fetch
mSourceAnnotation <- case candidate.sourceAnnotationId of
Nothing -> pure Nothing
Just aid -> fetchOneOrNothing aid
mSourceThread <- case candidate.sourceThreadId of
Nothing -> pure Nothing
Just tid -> fetchOneOrNothing tid
render ShowView { candidate, widget, triageStates, mAssignment, users, mSourceAnnotation, mSourceThread }
action NewRequirementCandidateAction = do
widgets <- query @Widget |> fetch
threads <- query @AnnotationThread |> fetch
let candidate = newRecord @RequirementCandidate
render NewView { candidate, widgets, threads }
action CreateRequirementCandidateAction = do
widgets <- query @Widget |> fetch
threads <- query @AnnotationThread |> fetch
mUser <- currentUserOrNothing
let createdBy = fmap (.id) mUser
let candidate = newRecord @RequirementCandidate
candidate
|> fill @'["title", "description", "sourceWidgetId", "sourceThreadId", "category"]
|> set #status "open"
|> set #createdBy (fmap (Id . unId) createdBy)
|> validateField #title nonEmpty
|> validateField #description nonEmpty
|> validateField #category (`elem` validCategories)
|> ifValid \case
Left candidate -> render NewView { candidate, widgets, threads }
Right candidate -> do
created <- createRecord candidate
setSuccessMessage "Requirement candidate created"
redirectTo ShowRequirementCandidateAction { requirementCandidateId = created.id }
action EditRequirementCandidateAction { requirementCandidateId } = do
candidate <- fetch requirementCandidateId
widgets <- query @Widget |> fetch
threads <- query @AnnotationThread |> fetch
render EditView { candidate, widgets, threads }
action UpdateRequirementCandidateAction { requirementCandidateId } = do
candidate <- fetch requirementCandidateId
widgets <- query @Widget |> fetch
threads <- query @AnnotationThread |> fetch
candidate
|> fill @'["title", "description", "sourceWidgetId", "sourceThreadId", "category"]
|> validateField #title nonEmpty
|> validateField #description nonEmpty
|> validateField #category (`elem` validCategories)
|> ifValid \case
Left candidate -> render EditView { candidate, widgets, threads }
Right candidate -> do
updateRecord candidate
setSuccessMessage "Candidate updated"
redirectTo ShowRequirementCandidateAction { requirementCandidateId }
action UpdateTriageStatusAction { requirementCandidateId } = do
candidate <- fetch requirementCandidateId
newStatus <- param @Text "status"
notes <- paramOrNothing @Text "notes"
mUser <- currentUserOrNothing
let changedBy = fmap (.id) mUser
if allowedTransition candidate.status newStatus
then do
-- Insert triage state row (append-only audit trail)
newRecord @TriageState
|> set #candidateId requirementCandidateId
|> set #status newStatus
|> set #notes notes
|> set #changedBy (fmap (Id . unId) changedBy)
|> createRecord
-- Update current status on candidate
candidate
|> set #status newStatus
|> updateRecord
setSuccessMessage ("Status updated to " <> newStatus)
redirectTo ShowRequirementCandidateAction { requirementCandidateId }
else do
setErrorMessage ("Invalid transition: " <> candidate.status <> " → " <> newStatus)
respondWith 422 do
redirectTo ShowRequirementCandidateAction { requirementCandidateId }
action AssignReviewerAction { requirementCandidateId } = do
userId <- param @(Id User) "userId"
mUser <- currentUserOrNothing
let assignedBy = fmap (.id) mUser
-- Upsert: delete existing assignment then insert
existing <- query @ReviewerAssignment
|> filterWhere (#candidateId, requirementCandidateId)
|> fetchOneOrNothing
case existing of
Just ra -> deleteRecord ra
Nothing -> pure ()
newRecord @ReviewerAssignment
|> set #candidateId requirementCandidateId
|> set #userId userId
|> set #assignedBy (fmap (Id . unId) assignedBy)
|> createRecord
setSuccessMessage "Reviewer assigned"
redirectTo ShowRequirementCandidateAction { requirementCandidateId }
action MyQueueAction = do
mUser <- currentUserOrNothing
case mUser of
Nothing -> redirectTo RequirementCandidatesAction
Just user -> do
assignments <- query @ReviewerAssignment
|> filterWhere (#userId, user.id)
|> fetch
let candidateIds = map (.candidateId) assignments
candidates <- mapM fetch candidateIds
let active = filter (\c -> c.status `elem` ["open", "in_review"]) candidates
widgets <- query @Widget |> fetch
render IndexView
{ candidates = active
, assignments
, users = [user]
, widgets
, mStatusFilter = Just "my_queue"
}

6
Web/Routes.hs
View File

@@ -16,5 +16,11 @@ instance AutoRoute InteractionEventsController
-- Annotations (scoped to widget: /widgets/:widgetId/annotations/)
instance AutoRoute AnnotationsController
-- Annotation Threads (scoped to widget)
instance AutoRoute AnnotationThreadsController
-- Requirement Candidates
instance AutoRoute RequirementCandidatesController
-- Sessions
instance AutoRoute SessionsController

37
Web/Types.hs
View File

@@ -18,11 +18,12 @@ data WebApplication = WebApplication deriving (Eq, Show)
data HubsController
= HubsAction
| NewHubAction
| ShowHubAction { hubId :: !(Id Hub) }
| ShowHubAction { hubId :: !(Id Hub) }
| CreateHubAction
| EditHubAction { hubId :: !(Id Hub) }
| UpdateHubAction { hubId :: !(Id Hub) }
| DeleteHubAction { hubId :: !(Id Hub) }
| EditHubAction { hubId :: !(Id Hub) }
| UpdateHubAction { hubId :: !(Id Hub) }
| DeleteHubAction { hubId :: !(Id Hub) }
| TriageDashboardAction { hubId :: !(Id Hub) }
deriving (Eq, Show, Data)
data WidgetsController
@@ -39,9 +40,31 @@ data InteractionEventsController
deriving (Eq, Show, Data)
data AnnotationsController
= WidgetAnnotationsAction { widgetId :: !(Id Widget) }
| NewAnnotationAction { widgetId :: !(Id Widget) }
| CreateAnnotationAction { widgetId :: !(Id Widget) }
= WidgetAnnotationsAction { widgetId :: !(Id Widget) }
| ShowAnnotationAction { annotationId :: !(Id Annotation) }
| NewAnnotationAction { widgetId :: !(Id Widget) }
| CreateAnnotationAction { widgetId :: !(Id Widget) }
| EscalateAnnotationAction { annotationId :: !(Id Annotation) }
deriving (Eq, Show, Data)
data AnnotationThreadsController
= WidgetAnnotationThreadsAction { widgetId :: !(Id Widget) }
| ShowAnnotationThreadAction { annotationThreadId :: !(Id AnnotationThread) }
| NewAnnotationThreadAction { widgetId :: !(Id Widget) }
| CreateAnnotationThreadAction { widgetId :: !(Id Widget) }
| AssignAnnotationToThreadAction { annotationId :: !(Id Annotation) }
deriving (Eq, Show, Data)
data RequirementCandidatesController
= RequirementCandidatesAction
| ShowRequirementCandidateAction { requirementCandidateId :: !(Id RequirementCandidate) }
| NewRequirementCandidateAction
| CreateRequirementCandidateAction
| EditRequirementCandidateAction { requirementCandidateId :: !(Id RequirementCandidate) }
| UpdateRequirementCandidateAction { requirementCandidateId :: !(Id RequirementCandidate) }
| UpdateTriageStatusAction { requirementCandidateId :: !(Id RequirementCandidate) }
| AssignReviewerAction { requirementCandidateId :: !(Id RequirementCandidate) }
| MyQueueAction
deriving (Eq, Show, Data)
data SessionsController

92
Web/View/AnnotationThreads/Index.hs Normal file
View File

@@ -0,0 +1,92 @@
module Web.View.AnnotationThreads.Index where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
data IndexView = IndexView
{ widget :: !Widget
, threads :: ![AnnotationThread]
, allAnnotations :: ![Annotation]
}
instance View IndexView where
html IndexView { .. } = [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>
<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 }}
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>
|]}
|]
renderThreadRow :: [Annotation] -> AnnotationThread -> Html
renderThreadRow allAnnotations t =
let members = filter (\a -> a.threadId == Just t.id) allAnnotations
count = length members
severityBreakdown = buildSeverityBreakdown members
in [hsx|
<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 }}
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}
</div>
<span class="text-xs text-gray-400 ml-4 whitespace-nowrap">{show t.createdAt}</span>
</div>
<div class="mt-3 flex items-center gap-3 text-xs text-gray-500">
<span>{show count} annotation(s)</span>
{renderSeverityBreakdown severityBreakdown}
</div>
</div>
|]
buildSeverityBreakdown :: [Annotation] -> [(Text, Int)]
buildSeverityBreakdown annotations =
[ ("low", length $ filter (\a -> a.severity == "low") annotations)
, ("medium", length $ filter (\a -> a.severity == "medium") annotations)
, ("high", length $ filter (\a -> a.severity == "high") annotations)
, ("critical", length $ filter (\a -> a.severity == "critical") annotations)
]
renderSeverityBreakdown :: [(Text, Int)] -> Html
renderSeverityBreakdown pairs = [hsx|
<span class="flex items-center gap-1">
{forEach (filter (\(_, n) -> n > 0) pairs) renderSeverityPip}
</span>
|]
renderSeverityPip :: (Text, Int) -> Html
renderSeverityPip (sev, n) = [hsx|
<span class={severityClass sev <> " text-xs px-1.5 py-0.5 rounded"}>
{sev}: {show n}
</span>
|]
severityClass :: Text -> Text
severityClass "low" = "bg-gray-100 text-gray-500"
severityClass "medium" = "bg-blue-100 text-blue-700"
severityClass "high" = "bg-yellow-100 text-yellow-800"
severityClass "critical" = "bg-red-100 text-red-800 font-semibold"
severityClass _ = "bg-gray-100 text-gray-500"

33
Web/View/AnnotationThreads/New.hs Normal file
View File

@@ -0,0 +1,33 @@
module Web.View.AnnotationThreads.New where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
data NewView = NewView
{ widget :: !Widget
, thread :: !AnnotationThread
}
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>
<span>/</span>
<a href={WidgetAnnotationThreadsAction { widgetId = widget.id }} class="hover:text-gray-700">Threads</a>
<span>/</span>
<span>New</span>
</div>
<div class="max-w-lg">
<h1 class="text-2xl font-semibold mb-6">New Annotation Thread</h1>
{renderForm thread widget.id}
</div>
|]
renderForm :: AnnotationThread -> Id Widget -> Html
renderForm thread widgetId = formFor thread [hsx|
{(textField #title) { fieldLabel = "Title" }}
{(textareaField #description) { fieldLabel = "Description (optional)" }}
{submitButton}
|]

96
Web/View/AnnotationThreads/Show.hs Normal file
View File

@@ -0,0 +1,96 @@
module Web.View.AnnotationThreads.Show where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
data ShowView = ShowView
{ widget :: !Widget
, thread :: !AnnotationThread
, annotations :: ![Annotation]
}
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>
<span>/</span>
<a href={WidgetAnnotationThreadsAction { widgetId = widget.id }} class="hover:text-gray-700">Threads</a>
<span>/</span>
<span>{thread.title}</span>
</div>
<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}
</div>
<div class="mb-4 flex items-center gap-3">
{renderSeverityBar annotations}
<span class="text-xs text-gray-500">{dominantCategoryBadge annotations}</span>
</div>
<div class="space-y-3">
{forEach annotations renderAnnotationCard}
</div>
</div>
|]
renderAnnotationCard :: Annotation -> Html
renderAnnotationCard a = [hsx|
<div class="bg-white rounded-lg border border-gray-200 px-4 py-3">
<div class="flex items-center gap-2 mb-2">
<span class="text-xs bg-gray-100 text-gray-600 px-2 py-0.5 rounded">{a.category}</span>
<span class={severityClass a.severity <> " text-xs px-2 py-0.5 rounded"}>
{a.severity}
</span>
</div>
<p class="text-sm text-gray-700">{a.body}</p>
</div>
|]
renderSeverityBar :: [Annotation] -> Html
renderSeverityBar annotations =
let total = length annotations
counts = map (\s -> (s, length $ filter (\a -> a.severity == s) annotations))
["critical", "high", "medium", "low"]
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>
|]
renderBarSegment :: Text -> Int -> Int -> Html
renderBarSegment sev n total =
let pct = (n * 100) `div` total
in [hsx|
<div class={barColor sev <> " h-2 rounded"} style={"width: " <> show pct <> "px"} title={sev <> ": " <> show n}>
</div>
|]
barColor :: Text -> Text
barColor "low" = "bg-gray-300"
barColor "medium" = "bg-blue-400"
barColor "high" = "bg-yellow-400"
barColor "critical" = "bg-red-500"
barColor _ = "bg-gray-300"
dominantCategoryBadge :: [Annotation] -> Text
dominantCategoryBadge [] = ""
dominantCategoryBadge annotations =
let cats = map (.category) annotations
tally = map (\c -> (c, length $ filter (== c) cats)) (nub cats)
best = foldl1 (\(c1, n1) (c2, n2) -> if n2 > n1 then (c2, n2) else (c1, n1)) tally
in fst best
severityClass :: Text -> Text
severityClass "low" = "bg-gray-100 text-gray-500"
severityClass "medium" = "bg-blue-100 text-blue-700"
severityClass "high" = "bg-yellow-100 text-yellow-800"
severityClass "critical" = "bg-red-100 text-red-800 font-semibold"
severityClass _ = "bg-gray-100 text-gray-500"

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

@@ -43,6 +43,9 @@ renderAnnotation childrenOf a = [hsx|
<span class="text-xs bg-gray-100 text-gray-600 px-2 py-0.5 rounded font-medium">
{a.category}
</span>
<span class={severityClass a.severity}>
{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>|]
@@ -53,9 +56,18 @@ renderAnnotation childrenOf a = [hsx|
<div class="mt-2 flex gap-2">
<a href={NewAnnotationAction { widgetId = a.widgetId }}
class="text-xs text-indigo-500 hover:text-indigo-700">Reply</a>
<a href={ShowAnnotationAction { annotationId = 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">
{forEach (childrenOf a) (renderAnnotation childrenOf)}
</div>
</div>
|]
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"
severityClass "high" = "text-xs px-2 py-0.5 rounded bg-yellow-100 text-yellow-800"
severityClass "critical" = "text-xs px-2 py-0.5 rounded bg-red-100 text-red-800 font-semibold"
severityClass _ = "text-xs px-2 py-0.5 rounded bg-gray-100 text-gray-500"

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

@@ -29,16 +29,25 @@ renderForm :: Annotation -> Id Widget -> Html
renderForm annotation widgetId = formFor annotation [hsx|
{(textareaField #body) { fieldLabel = "Comment" }}
{selectField #category categoryOptions}
{selectField #severity severityOptions}
{submitButton}
|]
categoryOptions :: [(Text, Text)]
categoryOptions =
[ ("Friction", "friction")
, ("Defect", "defect")
, ("Wish", "wish")
, ("Policy Concern", "policy_concern")
[ ("Friction", "friction")
, ("Defect", "defect")
, ("Wish", "wish")
, ("Policy Concern", "policy_concern")
, ("Documentation Gap", "doc_gap")
, ("Trust", "trust")
, ("Other", "other")
, ("Trust", "trust")
, ("Other", "other")
]
severityOptions :: [(Text, Text)]
severityOptions =
[ ("Low", "low")
, ("Medium", "medium")
, ("High", "high")
, ("Critical", "critical")
]

85
Web/View/Annotations/Show.hs Normal file
View File

@@ -0,0 +1,85 @@
module Web.View.Annotations.Show where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
data ShowView = ShowView
{ widget :: !Widget
, annotation :: !Annotation
, mCandidate :: !(Maybe RequirementCandidate)
}
instance View ShowView where
html ShowView { .. } = [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>
<span>/</span>
<a href={WidgetAnnotationsAction { widgetId = widget.id }} class="hover:text-gray-700">Annotations</a>
<span>/</span>
<span>Detail</span>
</div>
<div class="max-w-2xl">
<div class="bg-white rounded-lg border border-gray-200 px-6 py-5 mb-4">
<div class="flex items-center gap-2 mb-3">
<span class="text-xs bg-gray-100 text-gray-600 px-2 py-0.5 rounded font-medium">
{annotation.category}
</span>
<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}
<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>
</div>
<div class="bg-gray-50 rounded-lg border border-gray-200 px-6 py-4">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Escalation</h2>
{renderEscalation annotation mCandidate}
</div>
</div>
|]
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"}
<button type="submit"
class="text-sm bg-amber-600 text-white px-4 py-2 rounded hover:bg-amber-700">
Escalate to Requirement Candidate
</button>
</form>
|]
renderEscalation _ (Just candidate) = [hsx|
<p class="text-sm text-gray-600 mb-2">Escalated to:</p>
<a href={ShowRequirementCandidateAction { requirementCandidateId = candidate.id }}
class="text-sm text-indigo-600 hover:text-indigo-800 font-medium">
{candidate.title} →
</a>
<span class={candidateStatusClass candidate.status <> " ml-3 text-xs px-2 py-0.5 rounded"}>
{candidate.status}
</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"
severityClass "high" = "text-xs px-2 py-0.5 rounded bg-yellow-100 text-yellow-800"
severityClass "critical" = "text-xs px-2 py-0.5 rounded bg-red-100 text-red-800 font-semibold"
severityClass _ = "text-xs px-2 py-0.5 rounded bg-gray-100 text-gray-500"
candidateStatusClass :: Text -> Text
candidateStatusClass "open" = "bg-blue-100 text-blue-700"
candidateStatusClass "in_review" = "bg-yellow-100 text-yellow-800"
candidateStatusClass "accepted" = "bg-green-100 text-green-800"
candidateStatusClass "rejected" = "bg-red-100 text-red-800"
candidateStatusClass "deferred" = "bg-gray-100 text-gray-600"
candidateStatusClass _ = "bg-gray-100 text-gray-600"

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

@@ -29,6 +29,10 @@ instance View ShowView where
</p>
</div>
<div class="flex gap-2">
<a href={TriageDashboardAction { hubId = 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={EditHubAction { hubId = hub.id }}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Edit

158
Web/View/Hubs/TriageDashboard.hs Normal file
View File

@@ -0,0 +1,158 @@
module Web.View.Hubs.TriageDashboard where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
data TriageDashboardView = TriageDashboardView
{ hub :: !Hub
, widgets :: ![Widget]
, allCandidates :: ![RequirementCandidate]
, triageQueue :: ![RequirementCandidate]
, recentEscalations :: ![RequirementCandidate]
, allAnnotations :: ![Annotation]
}
instance View TriageDashboardView where
html TriageDashboardView { .. } = [hsx|
{autoRefreshMeta}
<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>
<span>/</span>
<span>Triage Dashboard</span>
</div>
<div class="flex items-center justify-between mb-6">
<h1 class="text-2xl font-semibold">Triage Dashboard — {hub.name}</h1>
<a href={RequirementCandidatesAction}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
All Candidates
</a>
</div>
<!-- KPI row -->
<div class="grid grid-cols-5 gap-3 mb-8">
{renderKpi "Open" "open" allCandidates "bg-blue-50 border-blue-200 text-blue-800"}
{renderKpi "In Review" "in_review" allCandidates "bg-yellow-50 border-yellow-200 text-yellow-800"}
{renderKpi "Accepted" "accepted" allCandidates "bg-green-50 border-green-200 text-green-800"}
{renderKpi "Rejected" "rejected" allCandidates "bg-red-50 border-red-200 text-red-800"}
{renderKpi "Deferred" "deferred" allCandidates "bg-gray-50 border-gray-200 text-gray-700"}
</div>
<div class="grid grid-cols-2 gap-6 mb-8">
<!-- 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>
|]}
</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>
|]}
</section>
</div>
<!-- Category breakdown -->
<section>
<h2 class="text-lg font-medium mb-3">Annotation Category Breakdown</h2>
{renderCategoryBreakdown allAnnotations}
</section>
|]
renderKpi :: Text -> Text -> [RequirementCandidate] -> Text -> Html
renderKpi label status candidates colorClass =
let n = length $ filter (\c -> c.status == status) candidates
in [hsx|
<div class={"rounded-lg border p-4 " <> colorClass}>
<p class="text-xs font-medium uppercase tracking-wide opacity-70">{label}</p>
<p class="text-3xl font-semibold mt-1">{show n}</p>
</div>
|]
renderQueueItem :: [Widget] -> RequirementCandidate -> Html
renderQueueItem widgets c =
let mWidget = find (\w -> w.id == c.sourceWidgetId) widgets
age = show c.createdAt
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 }}
class="text-sm font-medium text-indigo-600 hover:text-indigo-800 leading-snug">
{c.title}
</a>
<span class="text-xs text-gray-400 whitespace-nowrap shrink-0">{age}</span>
</div>
<div class="mt-1 flex gap-2 text-xs text-gray-500">
<span>{maybe "—" (.name) mWidget}</span>
<span class="text-gray-300">·</span>
<span class="bg-gray-100 px-1.5 rounded">{c.category}</span>
</div>
</div>
|]
renderEscalationItem :: [Widget] -> RequirementCandidate -> Html
renderEscalationItem widgets c =
let mWidget = find (\w -> w.id == c.sourceWidgetId) widgets
in [hsx|
<div class="bg-white rounded border border-gray-200 px-4 py-3">
<div class="flex items-center gap-2 mb-1">
<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 }}
class="text-sm text-indigo-600 hover:text-indigo-800">{c.title}</a>
</div>
|]
renderCategoryBreakdown :: [Annotation] -> Html
renderCategoryBreakdown annotations =
let categories = ["friction", "defect", "wish", "policy_concern", "doc_gap", "trust", "other"]
counts = map (\cat -> (cat, length $ filter (\a -> a.category == cat) annotations)) categories
nonZero = filter (\(_, n) -> n > 0) counts
total = length annotations
in if total == 0
then [hsx|<p class="text-sm text-gray-400">No annotations yet.</p>|]
else [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-4">
<div class="space-y-2">
{forEach nonZero (renderCategoryBar total)}
</div>
</div>
|]
renderCategoryBar :: Int -> (Text, Int) -> Html
renderCategoryBar total (cat, n) =
let pct = if total > 0 then (n * 100) `div` total else 0
in [hsx|
<div class="flex items-center gap-3 text-sm">
<span class="w-32 text-gray-600 text-xs">{cat}</span>
<div class="flex-1 bg-gray-100 rounded-full h-2">
<div class="bg-indigo-500 h-2 rounded-full" style={"width: " <> show pct <> "%"}></div>
</div>
<span class="w-8 text-right text-xs text-gray-500">{show n}</span>
</div>
|]
statusClass :: Text -> Text
statusClass "open" = "bg-blue-100 text-blue-700"
statusClass "in_review" = "bg-yellow-100 text-yellow-800"
statusClass "accepted" = "bg-green-100 text-green-800"
statusClass "rejected" = "bg-red-100 text-red-800"
statusClass "deferred" = "bg-gray-100 text-gray-600"
statusClass _ = "bg-gray-100 text-gray-600"

55
Web/View/RequirementCandidates/Edit.hs Normal file
View File

@@ -0,0 +1,55 @@
module Web.View.RequirementCandidates.Edit where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
data EditView = EditView
{ candidate :: !RequirementCandidate
, widgets :: ![Widget]
, threads :: ![AnnotationThread]
}
instance View EditView where
html EditView { .. } = [hsx|
<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 }}
class="hover:text-gray-700">{candidate.title}</a>
<span>/</span>
<span>Edit</span>
</div>
<div class="max-w-lg">
<h1 class="text-2xl font-semibold mb-6">Edit Candidate</h1>
{renderForm candidate widgets threads}
</div>
|]
renderForm :: RequirementCandidate -> [Widget] -> [AnnotationThread] -> Html
renderForm candidate widgets threads = formFor candidate [hsx|
{(textField #title) { fieldLabel = "Title" }}
{(textareaField #description) { fieldLabel = "Description" }}
{selectField #sourceWidgetId (widgetOptions widgets)}
{selectField #sourceThreadId (threadOptions threads)}
{selectField #category categoryOptions}
{submitButton}
|]
widgetOptions :: [Widget] -> [(Text, Text)]
widgetOptions = map (\w -> (w.name, show w.id))
threadOptions :: [AnnotationThread] -> [(Text, Text)]
threadOptions threads = ("None", "") : map (\t -> (t.title, show t.id)) threads
categoryOptions :: [(Text, Text)]
categoryOptions =
[ ("Friction", "friction")
, ("Defect", "defect")
, ("Wish", "wish")
, ("Policy Concern", "policy_concern")
, ("Documentation Gap", "doc_gap")
, ("Trust", "trust")
, ("Other", "other")
]

116
Web/View/RequirementCandidates/Index.hs Normal file
View File

@@ -0,0 +1,116 @@
module Web.View.RequirementCandidates.Index where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
data IndexView = IndexView
{ candidates :: ![RequirementCandidate]
, assignments :: ![ReviewerAssignment]
, users :: ![User]
, widgets :: ![Widget]
, mStatusFilter :: !(Maybe Text)
}
instance View IndexView where
html IndexView { .. } = [hsx|
<div class="flex items-center justify-between mb-6">
<h1 class="text-2xl font-semibold">Requirement Candidates</h1>
<div class="flex gap-2">
<a href={MyQueueAction}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
My Queue
</a>
<a href={NewRequirementCandidateAction}
class="bg-indigo-600 text-white text-sm font-medium px-4 py-2 rounded hover:bg-indigo-700">
New Candidate
</a>
</div>
</div>
<div class="flex gap-2 mb-4 flex-wrap">
{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>
|]}
|]
renderFilterPills :: Maybe Text -> Html
renderFilterPills current = [hsx|
{renderPill Nothing current "All"}
{renderPill (Just "open") current "Open"}
{renderPill (Just "in_review") current "In Review"}
{renderPill (Just "accepted") current "Accepted"}
{renderPill (Just "rejected") current "Rejected"}
{renderPill (Just "deferred") current "Deferred"}
|]
renderPill :: Maybe Text -> Maybe Text -> Text -> Html
renderPill target current label =
let isActive = target == current
baseClass = "text-xs px-3 py-1.5 rounded-full border "
cls = if isActive
then baseClass <> "bg-indigo-600 text-white border-indigo-600"
else baseClass <> "border-gray-300 text-gray-600 hover:bg-gray-50"
url = case target of
Nothing -> pathTo RequirementCandidatesAction
Just s -> pathTo RequirementCandidatesAction <> "?status=" <> s
in [hsx|<a href={url} class={cls}>{label}</a>|]
renderRow :: [ReviewerAssignment] -> [User] -> [Widget] -> RequirementCandidate -> Html
renderRow assignments users widgets c =
let mAssignment = find (\ra -> ra.candidateId == c.id) assignments
mReviewer = mAssignment >>= \ra -> find (\u -> u.id == ra.userId) users
mWidget = find (\w -> w.id == c.sourceWidgetId) widgets
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 }}
class="font-medium text-indigo-600 hover:text-indigo-800">
{c.title}
</a>
</td>
<td class="px-4 py-3 text-gray-500 text-xs">
{maybe "—" (.name) mWidget}
</td>
<td class="px-4 py-3">
<span class="text-xs bg-gray-100 text-gray-600 px-2 py-0.5 rounded">{c.category}</span>
</td>
<td class="px-4 py-3">
<span class={statusClass c.status <> " text-xs px-2 py-0.5 rounded"}>{c.status}</span>
</td>
<td class="px-4 py-3 text-gray-500 text-xs">
{maybe "Unassigned" (.name) mReviewer}
</td>
<td class="px-4 py-3 text-gray-400 text-xs">{show c.createdAt}</td>
</tr>
|]
statusClass :: Text -> Text
statusClass "open" = "bg-blue-100 text-blue-700"
statusClass "in_review" = "bg-yellow-100 text-yellow-800"
statusClass "accepted" = "bg-green-100 text-green-800"
statusClass "rejected" = "bg-red-100 text-red-800"
statusClass "deferred" = "bg-gray-100 text-gray-600"
statusClass _ = "bg-gray-100 text-gray-600"

52
Web/View/RequirementCandidates/New.hs Normal file
View File

@@ -0,0 +1,52 @@
module Web.View.RequirementCandidates.New where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
data NewView = NewView
{ candidate :: !RequirementCandidate
, widgets :: ![Widget]
, threads :: ![AnnotationThread]
}
instance View NewView where
html NewView { .. } = [hsx|
<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>
<span>New</span>
</div>
<div class="max-w-lg">
<h1 class="text-2xl font-semibold mb-6">New Requirement Candidate</h1>
{renderForm candidate widgets threads}
</div>
|]
renderForm :: RequirementCandidate -> [Widget] -> [AnnotationThread] -> Html
renderForm candidate widgets threads = formFor candidate [hsx|
{(textField #title) { fieldLabel = "Title" }}
{(textareaField #description) { fieldLabel = "Description" }}
{selectField #sourceWidgetId (widgetOptions widgets)}
{selectField #sourceThreadId (threadOptions threads)}
{selectField #category categoryOptions}
{submitButton}
|]
widgetOptions :: [Widget] -> [(Text, Text)]
widgetOptions = map (\w -> (w.name, show w.id))
threadOptions :: [AnnotationThread] -> [(Text, Text)]
threadOptions threads = ("None", "") : map (\t -> (t.title, show t.id)) threads
categoryOptions :: [(Text, Text)]
categoryOptions =
[ ("Friction", "friction")
, ("Defect", "defect")
, ("Wish", "wish")
, ("Policy Concern", "policy_concern")
, ("Documentation Gap", "doc_gap")
, ("Trust", "trust")
, ("Other", "other")
]

176
Web/View/RequirementCandidates/Show.hs Normal file
View File

@@ -0,0 +1,176 @@
module Web.View.RequirementCandidates.Show where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
data ShowView = ShowView
{ candidate :: !RequirementCandidate
, widget :: !Widget
, triageStates :: ![TriageState]
, mAssignment :: !(Maybe ReviewerAssignment)
, users :: ![User]
, mSourceAnnotation :: !(Maybe Annotation)
, mSourceThread :: !(Maybe AnnotationThread)
}
instance View ShowView where
html ShowView { .. } = [hsx|
<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>
<span>{candidate.title}</span>
</div>
<div class="max-w-3xl space-y-6">
<!-- Header card -->
<div class="bg-white rounded-lg border border-gray-200 px-6 py-5">
<div class="flex items-start justify-between mb-3">
<h1 class="text-2xl font-semibold">{candidate.title}</h1>
<div class="flex gap-2 ml-4">
<a href={EditRequirementCandidateAction { requirementCandidateId = candidate.id }}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Edit
</a>
</div>
</div>
<div class="flex items-center gap-2 mb-3">
<span class={statusClass candidate.status <> " text-xs px-2 py-0.5 rounded font-medium"}>
{candidate.status}
</span>
<span class="text-xs bg-gray-100 text-gray-600 px-2 py-0.5 rounded">
{candidate.category}
</span>
<span class="text-xs text-gray-400">
Widget: {widget.name}
</span>
</div>
<p class="text-sm text-gray-700 leading-relaxed">{candidate.description}</p>
</div>
<!-- Source -->
<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">Source</h2>
{renderSource mSourceAnnotation mSourceThread}
</div>
<!-- Triage actions -->
<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</h2>
{renderTriageActions candidate}
</div>
<!-- Reviewer assignment -->
<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">Reviewer</h2>
{renderReviewerSection candidate mAssignment users}
</div>
<!-- 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>
|]}
</div>
</div>
|]
renderSource :: Maybe Annotation -> Maybe AnnotationThread -> Html
renderSource Nothing Nothing = [hsx|<p class="text-sm text-gray-400">No source linked.</p>|]
renderSource (Just a) _ = [hsx|
<div class="text-sm">
<p class="text-gray-500 mb-1">Source annotation:</p>
<p class="text-gray-700 italic">"{a.body}"</p>
</div>
|]
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 }}
class="text-indigo-600 hover:text-indigo-800">{t.title}</a>
</div>
|]
renderTriageActions :: RequirementCandidate -> Html
renderTriageActions c = [hsx|
<div class="flex flex-wrap gap-2">
{forEach (allowedNextStatuses c.status) (renderTriageButton c.id)}
</div>
|]
allowedNextStatuses :: Text -> [Text]
allowedNextStatuses "open" = ["in_review"]
allowedNextStatuses "in_review" = ["accepted", "rejected", "deferred"]
allowedNextStatuses "deferred" = ["in_review"]
allowedNextStatuses _ = []
renderTriageButton :: Id RequirementCandidate -> Text -> Html
renderTriageButton candidateId newStatus = [hsx|
<form method="POST" action={UpdateTriageStatusAction { requirementCandidateId = candidateId }}
class="inline">
{hiddenField "authenticity_token"}
<input type="hidden" name="status" value={newStatus} />
<button type="submit" class={triageButtonClass newStatus}>
→ {newStatus}
</button>
</form>
|]
triageButtonClass :: Text -> Text
triageButtonClass "accepted" = "text-sm px-3 py-1.5 rounded border bg-green-50 border-green-300 text-green-800 hover:bg-green-100"
triageButtonClass "rejected" = "text-sm px-3 py-1.5 rounded border bg-red-50 border-red-300 text-red-800 hover:bg-red-100"
triageButtonClass "deferred" = "text-sm px-3 py-1.5 rounded border bg-gray-50 border-gray-300 text-gray-700 hover:bg-gray-100"
triageButtonClass _ = "text-sm px-3 py-1.5 rounded border bg-yellow-50 border-yellow-300 text-yellow-800 hover:bg-yellow-100"
renderReviewerSection :: RequirementCandidate -> Maybe ReviewerAssignment -> [User] -> Html
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>|]}
</div>
<form method="POST" action={AssignReviewerAction { requirementCandidateId = 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>|])}
</select>
<button type="submit"
class="text-sm bg-indigo-600 text-white px-3 py-1 rounded hover:bg-indigo-700">
Assign
</button>
</form>
</div>
|]
reviewerName :: ReviewerAssignment -> [User] -> Text
reviewerName ra users =
maybe "Unknown" (.name) (find (\u -> u.id == ra.userId) users)
renderTriageRow :: TriageState -> Html
renderTriageRow ts = [hsx|
<li class="flex items-start gap-3 text-sm">
<span class={statusClass ts.status <> " text-xs px-2 py-0.5 rounded mt-0.5 shrink-0"}>
{ts.status}
</span>
<div>
{maybe mempty (\n -> [hsx|<p class="text-gray-700">{n}</p>|]) ts.notes}
<p class="text-xs text-gray-400">{show ts.changedAt}</p>
</div>
</li>
|]
statusClass :: Text -> Text
statusClass "open" = "bg-blue-100 text-blue-700"
statusClass "in_review" = "bg-yellow-100 text-yellow-800"
statusClass "accepted" = "bg-green-100 text-green-800"
statusClass "rejected" = "bg-red-100 text-red-800"
statusClass "deferred" = "bg-gray-100 text-gray-600"
statusClass _ = "bg-gray-100 text-gray-600"

119
docs/phase2-summary.md Normal file
View File

@@ -0,0 +1,119 @@
# IHF Phase 2 — Structured Feedback and Triage: Summary
## What Was Built
Phase 2 transforms raw annotations into governable, triageable feedback. It delivers five
capabilities on top of the Phase 1 interaction core.
### 1. Annotation Severity (`T01`, `T02`)
Every annotation now carries a `severity` value (`low` / `medium` / `high` / `critical`,
default `medium`). Severity is validated on create, displayed with Tailwind color cues
(gray / blue / yellow / red), and visible throughout annotation index, show, and thread views.
### 2. Annotation Threads (`T03`)
`AnnotationThread` groups related annotations under a named thread scoped to a widget.
Operators create threads manually, then assign individual annotations to them via
`AssignAnnotationToThreadAction`. Thread views show a severity distribution bar and
dominant category badge, giving a quick signal about the nature of the cluster.
Routes: `/widgets/:widgetId/threads/`
### 3. Requirement Candidates (`T04`, `T05`)
`RequirementCandidate` is the first artifact in the IHF traceability chain beyond raw
feedback. It can be created:
- **Manually** via `/requirement-candidates/new` (operator selects widget, thread, category).
- **By escalation** from an annotation detail page — `EscalateAnnotationAction` creates a
candidate pre-populated from the annotation and links `source_annotation_id`. Escalation
is idempotent: a second click redirects to the existing candidate.
Candidates are never deleted; they can only be rejected or deferred to preserve the audit trail.
### 4. Triage Lifecycle (`T06`)
`TriageState` records every status transition as an append-only audit log. Allowed transitions:
```
open → in_review
in_review → accepted | rejected | deferred
deferred → in_review
```
`UpdateTriageStatusAction` validates the transition and returns 422 on invalid moves.
The candidate's `status` column is kept in sync as a denormalised read-optimised cache;
`triage_states` is the authoritative history.
### 5. Reviewer Assignment & My Queue (`T07`)
`ReviewerAssignment` tracks one reviewer per candidate (unique constraint). Assignment is
an upsert (old record deleted, new inserted). `MyQueueAction` shows the current user's
assigned open/in-review candidates.
### 6. Triage Dashboard (`T08`)
`TriageDashboardAction` (on `HubsController`) is wrapped with `autoRefresh do` for live
push updates. It renders:
- **KPI row** — counts per status (open / in\_review / accepted / rejected / deferred).
- **Triage queue** — open candidates for the hub's widgets, oldest first.
- **Recent escalations** — last 20 candidates across the hub.
- **Category breakdown** — annotation counts per category as a horizontal bar chart.
The `{autoRefreshMeta}` tag is emitted in the view head; morphdom.js handles DOM diffing
on each WebSocket push.
---
## Files Created / Modified
| Path | Change |
|------|--------|
| `Application/Schema.sql` | Added `annotation_threads`, `severity`/`thread_id` on `annotations`, `requirement_candidates`, `triage_states`, `reviewer_assignments` |
| `Application/Migration/1743120000-ihf-phase2-feedback-triage.sql` | Phase 2 migration |
| `Web/Types.hs` | Extended `AnnotationsController`; added `AnnotationThreadsController`, `RequirementCandidatesController`, `TriageDashboardAction` |
| `Web/Routes.hs` | Registered Phase 2 controllers |
| `Web/Controller/Annotations.hs` | Added `ShowAnnotationAction`, `EscalateAnnotationAction`, severity binding |
| `Web/Controller/AnnotationThreads.hs` | New |
| `Web/Controller/RequirementCandidates.hs` | New — full CRUD + triage + reviewer + my-queue |
| `Web/Controller/Hubs.hs` | Added `TriageDashboardAction` |
| `Web/View/Annotations/New.hs` | Added severity select |
| `Web/View/Annotations/Index.hs` | Severity badges, Escalate/Details link |
| `Web/View/Annotations/Show.hs` | New — annotation detail + escalation UI |
| `Web/View/AnnotationThreads/{Index,New,Show}.hs` | New |
| `Web/View/RequirementCandidates/{Index,New,Edit,Show}.hs` | New |
| `Web/View/Hubs/Show.hs` | Triage Dashboard link |
| `Web/View/Hubs/TriageDashboard.hs` | New |
| `Test/Integration.hs` | Phase 2 integration tests |
| `SCOPE.md` | Updated current state to Phase 2 complete |
---
## Known Limitations
- **No HTMX partial swaps** — triage and escalation actions use full redirects rather than
HTMX in-place swaps. The architecture supports HTMX (types are `data`-driven), but the
Phase 2 target was to deliver correct behaviour; HTMX enhancement is Phase 3 polish.
- **No duplicate-detection heuristics** — annotation threading is fully operator-driven.
Automated similarity/clustering is Phase 3+ scope per the workplan notes.
- **My Queue is not linked from the nav** — accessible via `/my-queue`. A nav link should
be added in a follow-up.
- **TriageState is never cleaned up** — by design (append-only audit trail). No archival
policy is defined yet.
---
## Phase 3 Readiness
Phase 2 exit criteria are met:
- [x] Feedback volume can be triaged rather than merely stored
- [x] Multiple related comments can converge into a structured candidate
- [x] Reviewers can track status and ownership
Phase 3 (Decision Records) can begin. Prerequisites already in place:
- `RequirementCandidate` with `accepted` status is the input artifact.
- `source_widget_id`, `source_thread_id`, `source_annotation_id` provide full traceability back.
- `triage_states` audit trail establishes provenance for any future `DecisionRecord`.

20
workplans/IHUB-WP-0002-ihf-phase2-structured-feedback-and-triage.md
View File

@@ -4,7 +4,7 @@ type: workplan
title: "IHF Phase 2 — Structured Feedback and Triage"
domain: custodian
repo: inter-hub
status: active
status: done
owner: custodian
topic_slug: custodian
created: "2026-03-28"
@@ -57,7 +57,7 @@ Reference: `docs/ihp-overview.md`, `docs/ihp-data-and-queries.md`,
```task
id: IHUB-WP-0002-T01
status: todo
status: done
priority: high
state_hub_task_id: "eb267a9e-7e80-4913-b7a3-7f5adb04a0f2"
```
@@ -80,7 +80,7 @@ Generate IHP types via the IDE code generator.
```task
id: IHUB-WP-0002-T02
status: todo
status: done
priority: high
state_hub_task_id: "fdcbf823-484e-4f0f-a0ca-28f9222520af"
```
@@ -99,7 +99,7 @@ with correct color coding in list and show views.
```task
id: IHUB-WP-0002-T03
status: todo
status: done
priority: high
state_hub_task_id: "35b989a0-5e2a-4300-990b-f43d67de0727"
```
@@ -118,7 +118,7 @@ thread; thread list shows per-thread aggregates.
```task
id: IHUB-WP-0002-T04
status: todo
status: done
priority: high
state_hub_task_id: "4eb2a51c-1b3f-4b36-b945-6bfb14c2e680"
```
@@ -138,7 +138,7 @@ render correctly.
```task
id: IHUB-WP-0002-T05
status: todo
status: done
priority: high
state_hub_task_id: "5c3a154b-38e0-4e40-9e97-57aae1dbc95d"
```
@@ -157,7 +157,7 @@ action; escalated annotations show a visual marker.
```task
id: IHUB-WP-0002-T06
status: todo
status: done
priority: high
state_hub_task_id: "cd8c3ef1-e0f7-435f-ae20-e0760df5da83"
```
@@ -176,7 +176,7 @@ full history visible on candidate show page.
```task
id: IHUB-WP-0002-T07
status: todo
status: done
priority: medium
state_hub_task_id: "3dc9bfdb-06d0-48a5-8973-2e39c6e0f78a"
```
@@ -195,7 +195,7 @@ for the logged-in reviewer.
```task
id: IHUB-WP-0002-T08
status: todo
status: done
priority: high
state_hub_task_id: "82498422-1626-4479-9daa-3d7c7e088d8e"
```
@@ -214,7 +214,7 @@ triage status change without page reload.
```task
id: IHUB-WP-0002-T09
status: todo
status: done
priority: high
state_hub_task_id: "935de4d7-867f-49aa-bddf-6ff9435215de"
```

350
workplans/IHUB-WP-0003-ihf-phase3-governance-and-decision-linkage.md Normal file
View File

@@ -0,0 +1,350 @@
---
id: IHUB-WP-0003
type: workplan
title: "IHF Phase 3 — Governance and Decision Linkage"
domain: inter_hub
repo: inter-hub
status: active
owner: custodian
topic_slug: inter_hub
created: "2026-03-28"
updated: "2026-03-28"
state_hub_workstream_id: "5f201ee3-5922-4bdc-981d-e51db0a24f5e"
---
# IHF Phase 3 — Governance and Decision Linkage
## Goal
Make the framework governance-capable rather than feedback-capable only. Phase 2
established structured, triageable feedback and requirement candidates. Phase 3
promotes accepted candidates into formal Requirements, records the decisions that
act on them, links decisions to policy constraints and implementation work items,
and surfaces the resulting governance audit trail per hub.
## Background
Phase 1 (IHUB-WP-0001) delivered the Minimal Interaction Core. Phase 2
(IHUB-WP-0002) delivered Structured Feedback and Triage — annotation severity,
annotation threads, requirement candidates, triage lifecycle, reviewer assignment,
and triage dashboard. All Phase 2 exit criteria are met.
Phase 3 is the third of eight phases in the IHF specification
(`specs/InteractionHubFrameworkSpecification_v0.1.md`, §14 Phase 3). It closes
the central traceability chain:
```
Widget → InteractionEvent / Annotation
→ RequirementCandidate (Phase 2)
→ [accepted] → Requirement
→ DecisionRecord ← PolicyReference
→ ImplementationChangeReference
→ DeploymentRecord → OutcomeSignal (Phase 4+)
```
**Technology stack:** IHP v1.5 (Haskell, Nix), PostgreSQL, AutoRefresh
(governance dashboard), IHP forms (CRUD). Outcome immutability enforced at the
controller level (no update after creation).
Reference: `docs/ihp-overview.md`, `docs/ihp-data-and-queries.md`,
`docs/ihp-controllers-views-forms.md`, `docs/ihp-realtime.md`.
## Phase 3 Exit Criteria (from IHF spec §14 Phase 3)
- The system can explain why a requirement was or was not acted upon
- Governance records are linked to observed interaction issues (full traceability)
- Decision history is inspectable per hub
## Data Artifacts Introduced (Phase 3)
`Requirement`, `DecisionRecord`, `PolicyReference`, `ImplementationChangeReference`
Also extends: `RequirementCandidate` (adds `requirement_id` back-reference)
---
## Tasks
### T01 — Schema: DecisionRecord, PolicyReference, Requirement, ImplementationChangeReference
```task
id: IHUB-WP-0003-T01
status: todo
priority: high
state_hub_task_id: "829b1121-bde6-4d8e-8c82-2a2e2064f520"
```
Add Phase 3 tables to `Application/Schema.sql` and write migration:
```sql
CREATE TABLE requirements (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
title TEXT NOT NULL,
description TEXT NOT NULL,
source_candidate_id UUID NOT NULL REFERENCES requirement_candidates(id) ON DELETE RESTRICT,
status TEXT NOT NULL DEFAULT 'active',
created_by UUID REFERENCES users(id),
created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
);
CREATE INDEX requirements_source_candidate_id_idx ON requirements (source_candidate_id);
CREATE TABLE decision_records (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
title TEXT NOT NULL,
rationale TEXT NOT NULL,
outcome TEXT NOT NULL,
requirement_id UUID REFERENCES requirements(id) ON DELETE SET NULL,
candidate_id UUID REFERENCES requirement_candidates(id) ON DELETE SET NULL,
decided_by UUID REFERENCES users(id),
decided_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL,
notes TEXT,
created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
);
CREATE INDEX decision_records_outcome_idx ON decision_records (outcome);
CREATE INDEX decision_records_requirement_id_idx ON decision_records (requirement_id);
CREATE TABLE policy_references (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
decision_id UUID NOT NULL REFERENCES decision_records(id) ON DELETE CASCADE,
policy_scope TEXT NOT NULL,
constraint_note TEXT,
created_by UUID REFERENCES users(id),
created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
);
CREATE INDEX policy_references_decision_id_idx ON policy_references (decision_id);
CREATE TABLE implementation_change_references (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
decision_id UUID NOT NULL REFERENCES decision_records(id) ON DELETE CASCADE,
work_item_ref TEXT NOT NULL,
system TEXT NOT NULL DEFAULT 'github',
linked_by UUID REFERENCES users(id),
linked_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
);
CREATE INDEX impl_change_refs_decision_id_idx ON implementation_change_references (decision_id);
-- Back-reference: track which candidate was promoted to a requirement
ALTER TABLE requirement_candidates ADD COLUMN requirement_id UUID REFERENCES requirements(id) ON DELETE SET NULL;
```
- Valid `decision_records.outcome` values: `accepted`, `rejected`, `deferred`, `split`, `merged`, `reframed`
- Valid `policy_references.policy_scope` values: `internal`, `external`, `regulatory`, `contractual`, `architectural`
- Valid `requirements.status` values: `active`, `superseded`, `withdrawn`
- Verify Haskell types are generated correctly
**Exit criteria:** `migrate` runs cleanly; all Phase 3 types available in GHCi.
---
### T02 — Requirement promotion: RequirementCandidate → Requirement
```task
id: IHUB-WP-0003-T02
status: todo
priority: high
state_hub_task_id: "9d1edd55-628c-4354-82c3-2bf273f1b827"
```
1. Add `PromoteToRequirementAction { candidateId }` (POST from candidate show page)
2. Validate: candidate must have `status = 'accepted'`; return 422 with message otherwise
3. Idempotent: if `candidate.requirement_id` already set, redirect to existing requirement
4. On promotion: create `Requirement` record, set `candidate.requirement_id`
5. Scaffold `RequirementsController`: index, show (no new/create — requirements come from promotion only)
6. Show page: title, description, source candidate link, linked decision (if any), status badge
7. Index: table with status, source candidate, linked decision, created_at
**Exit criteria:** Accepted candidates can be promoted once; second promotion redirects; requirement visible in index and show.
---
### T03 — DecisionRecord controller and views
```task
id: IHUB-WP-0003-T03
status: todo
priority: high
state_hub_task_id: "171b38ab-c6e7-4b0e-94c0-ebc35f07488a"
```
1. Scaffold `DecisionRecordsController`
2. Actions: index, show, new, create, edit, update (no delete)
3. Fields: `title`, `rationale` (textarea), `outcome` (select), `decidedBy` (user select), `notes` (optional textarea)
4. Index view: table with outcome badge, linked requirement title, decided_by name, decided_at; filterable by outcome
5. Show view: full detail + linked requirement + policy references section + implementation refs section + actor attribution
**Exit criteria:** Decision records can be created manually, listed, filtered, and viewed with full context.
---
### T04 — Candidate → Decision linkage action
```task
id: IHUB-WP-0003-T04
status: todo
priority: high
state_hub_task_id: "eb45a76b-fd75-4a6c-bec6-e47095d5fa36"
```
1. Add "Create Decision" button on `RequirementCandidate` show page (requires `status = 'accepted'`)
2. `LinkToDecisionAction { candidateId }` (POST): creates a `DecisionRecord` pre-populated from candidate
- `title` = candidate title
- `rationale` seeded from candidate description
- `candidateId` set on the decision record
- If a promoted `Requirement` exists, set `requirementId` on the decision too
3. Idempotent: if decision already linked to this candidate, redirect to existing decision
4. Show "Linked Decision →" on candidate show page after linkage
**Exit criteria:** Single-click decision creation from an accepted candidate; idempotent; link visible on candidate show page.
---
### T05 — PolicyReference: link decisions to policy scope
```task
id: IHUB-WP-0003-T05
status: todo
priority: medium
state_hub_task_id: "4ef86992-d35e-4f62-a601-bd19e3ef63d3"
```
1. `AddPolicyReferenceAction { decisionId }` (POST from decision show page)
2. Fields: `policyScope` (select: internal/external/regulatory/contractual/architectural), `constraintNote` (optional)
3. Multiple policy refs per decision allowed
4. List policy refs on decision show page: scope badge + constraint note + created_at
5. Delete: `DeletePolicyReferenceAction` — policy refs may be removed (they are editorial, not audit-critical)
**Exit criteria:** Policy references can be added and removed from decisions; multiple refs per decision supported.
---
### T06 — ImplementationChangeReference: link decisions to work items
```task
id: IHUB-WP-0003-T06
status: todo
priority: medium
state_hub_task_id: "eac1baf2-9df7-48fd-880e-68d07e22a337"
```
1. `AddImplementationRefAction { decisionId }` (POST from decision show page)
2. Fields: `workItemRef` (free text — e.g. `#1234`, `PROJ-456`), `system` (select: github/linear/jira/other)
3. List refs on decision show page: system badge + ref text + linked_at
4. No external API calls — refs are manual pointers only
5. Delete: `DeleteImplementationRefAction` — refs are editorial, not audit-critical
**Exit criteria:** Implementation refs can be added and removed; multiple refs per decision; no external API integration required.
---
### T07 — Decision outcomes: full outcome vocabulary
```task
id: IHUB-WP-0003-T07
status: todo
priority: high
state_hub_task_id: "eaa425b3-42a7-4498-8aa6-1610959ce16b"
```
1. Validate outcome on create against allowed set: `accepted`, `rejected`, `deferred`, `split`, `merged`, `reframed`
2. Outcome is **immutable** after creation — `UpdateDecisionRecordAction` may not change `outcome`
3. Color roles per `specs/TailwindForInteractionHubs_v0.2.md`:
- `accepted` → green
- `rejected` → red
- `deferred` → gray
- `split` → purple
- `merged` → indigo
- `reframed` → orange/amber
4. For `split` / `merged` outcomes: `notes` field should capture related candidate IDs or context
5. Display outcome badge consistently across index, show, and governance dashboard views
**Exit criteria:** All six outcomes render with correct color; outcome immutable after create; split/merged notes convention documented inline.
---
### T08 — Hub governance audit trail dashboard
```task
id: IHUB-WP-0003-T08
status: todo
priority: high
state_hub_task_id: "6bd3f8f2-13c1-4f95-a1cf-53a210b8e366"
```
1. Add `GovernanceDashboardAction { hubId }` to `HubsController` wrapped with `autoRefresh do`
2. Dashboard panels:
- **KPI row**: decision counts by outcome (accepted / rejected / deferred / split / merged / reframed)
- **Recent decisions** (last 20): title, outcome badge, widget origin (via requirement → candidate → widget), decided_at
- **Traceability coverage**: per widget — ✓/✗ for has annotation, has candidate, has decision
- **Open requirements awaiting decision**: requirements with no linked `decision_id`
3. Link from hub Show page alongside "Triage Dashboard"
**Exit criteria:** Dashboard live-updates on decision/requirement changes. Traceability coverage gives a quick health signal per widget.
---
### T09 — Phase 3 gate: tests, consistency, docs
```task
id: IHUB-WP-0003-T09
status: todo
priority: high
state_hub_task_id: "6f1a08f1-c114-4a19-bf71-cbb2421171e1"
```
1. **Integration tests** (`Test/`):
- Requirement promotion: accepted candidate → requirement; unaccepted candidate → 422; duplicate → idempotent
- Decision create + link to candidate; link to requirement if promoted
- PolicyReference add + delete
- ImplementationChangeReference add + delete
- Outcome immutability: update attempt on outcome field rejected
- Governance dashboard: data fetch compiles and returns correct counts
2. **Consistency sync:**
```bash
cd ~/the-custodian && make fix-consistency REPO=inter-hub
```
Or via State Hub MCP: `check_repo_consistency(repo_slug="inter-hub", fix=True)`
3. **Documentation updates:**
- Update `SCOPE.md` current state section: Phase 3 complete
- Write `docs/phase3-summary.md`: what was built, known limitations, Phase 4 readiness
4. **Smoke test checklist:**
- `devenv up` → clean start
- Accept a requirement candidate via triage
- Promote to requirement
- Create decision linked to candidate
- Add policy reference (regulatory)
- Add implementation ref (github, `#42`)
- Confirm governance dashboard shows decision and traceability coverage
- Confirm outcome cannot be changed after creation
**Exit criteria:** All tests pass; consistency sync reports no errors; smoke test completed; SCOPE.md updated.
---
## Phase 3 Dependencies
- Phase 2 schema stable (T01 depends on `requirement_candidates`, `users` from Phase 2)
- `requirements` before `decision_records` FK reference (T01 ordering)
- Schema (T01) before all controller work (T02–T08)
- `Requirement` (T02) before `DecisionRecord` linkage (T04)
- `DecisionRecord` (T03) before `PolicyReference` (T05), `ImplementationChangeReference` (T06), outcome vocabulary (T07)
- All feature tasks (T01–T08) before gate (T09)
## Notes
- **Outcome is immutable.** Unlike `TriageState` (which appends rows), `DecisionRecord.outcome`
is set at creation and never changed. A wrong decision should be superseded by creating a new
decision record with a note referencing the original, not by editing the existing one.
- **No delete on DecisionRecord or Requirement.** These are audit artifacts. Use `status =
'withdrawn'` on Requirement or `outcome = 'rejected'` on DecisionRecord to express
nullification.
- **PolicyReference and ImplementationChangeReference are editorial** — they may be added
and deleted freely. They do not constitute audit trail themselves; the DecisionRecord is
the audit artifact.
- **Traceability coverage (T08)** is a spot-check UI, not an enforced constraint. Phase 4+
will introduce automated gap detection via outcome signals.
- **No state-hub integration in Phase 3.** The `the-custodian` state-hub is a separate system;
cross-linking IHF decisions to state-hub decision records is Phase 5+ scope.