generated from coulomb/repo-seed
feat(P5): IHF Phase 5 complete — agent-assisted distillation
Some checks failed
Test / test (push) Has been cancelled
Some checks failed
Test / test (push) Has been cancelled
Adds bounded AI support to the IHF governance loop. All AI outputs are attributed (model_ref), reviewable (AgentReviewRecord), and reversible. No autonomous decisions; no silent requirement promotion. - T01: Schema — agent_proposals, agent_review_records, confidence_annotations (migration 1743379200) - T02: AgentProposalsController (index/show/accept/reject, idempotent review guard), global nav "Agent" link - T03: SummarizeClusterAction — Claude API cluster summary on widget show - T04: DraftRequirementAction — AI requirement draft; acceptance creates RequirementCandidate (human-gated) - T05: DetectDuplicatesAction — duplicate_flag proposal on candidate show - T06: DetectPolicySensitivityAction — policy_flag with ConfidenceAnnotations per concern scope - T07: ProposeImplementationAction — impl_proposal from decision show - T08: AgentAuditDashboardAction — autoRefresh; KPI row, unreviewed queue, recent proposals, attribution log matrix - T09: integration tests, SCOPE.md updated, phase5-summary.md, flake.nix adds http-conduit/aeson/string-conversions Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
128
Web/Controller/AgentProposals.hs
Normal file
128
Web/Controller/AgentProposals.hs
Normal file
@@ -0,0 +1,128 @@
|
||||
module Web.Controller.AgentProposals where
|
||||
|
||||
import Web.Types
|
||||
import Web.View.AgentProposals.Index
|
||||
import Web.View.AgentProposals.Show
|
||||
import Generated.Types
|
||||
import IHP.Prelude
|
||||
import IHP.ControllerPrelude
|
||||
import Data.Aeson (decode)
|
||||
import Data.ByteString.Lazy (fromStrict)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
|
||||
instance Controller AgentProposalsController where
|
||||
beforeAction = ensureIsUser
|
||||
|
||||
action AgentProposalsAction = do
|
||||
mTypeFilter <- paramOrNothing @Text "proposal_type"
|
||||
mStatusFilter <- paramOrNothing @Text "status"
|
||||
proposals <- case (mTypeFilter, mStatusFilter) of
|
||||
(Nothing, Nothing) ->
|
||||
query @AgentProposal |> orderByDesc #createdAt |> fetch
|
||||
(Just t, Nothing) ->
|
||||
query @AgentProposal
|
||||
|> filterWhere (#proposalType, t)
|
||||
|> orderByDesc #createdAt |> fetch
|
||||
(Nothing, Just s) ->
|
||||
query @AgentProposal
|
||||
|> filterWhere (#status, s)
|
||||
|> orderByDesc #createdAt |> fetch
|
||||
(Just t, Just s) ->
|
||||
query @AgentProposal
|
||||
|> filterWhere (#proposalType, t)
|
||||
|> filterWhere (#status, s)
|
||||
|> orderByDesc #createdAt |> fetch
|
||||
widgets <- query @Widget |> fetch
|
||||
render IndexView { proposals, widgets, mTypeFilter, mStatusFilter }
|
||||
|
||||
action ShowAgentProposalAction { agentProposalId } = do
|
||||
proposal <- fetch agentProposalId
|
||||
mWidget <- case proposal.sourceWidgetId of
|
||||
Nothing -> pure Nothing
|
||||
Just wid -> fetchOneOrNothing wid
|
||||
mCandidate <- case proposal.sourceCandidateId of
|
||||
Nothing -> pure Nothing
|
||||
Just cid -> fetchOneOrNothing cid
|
||||
mDecision <- case proposal.sourceDecisionId of
|
||||
Nothing -> pure Nothing
|
||||
Just did -> fetchOneOrNothing did
|
||||
mReview <- query @AgentReviewRecord
|
||||
|> filterWhere (#proposalId, agentProposalId)
|
||||
|> fetchOneOrNothing
|
||||
confidences <- query @ConfidenceAnnotation
|
||||
|> filterWhere (#proposalId, agentProposalId)
|
||||
|> orderByAsc #createdAt
|
||||
|> fetch
|
||||
users <- query @User |> fetch
|
||||
render ShowView
|
||||
{ proposal, mWidget, mCandidate, mDecision
|
||||
, mReview, confidences, users }
|
||||
|
||||
action AcceptProposalAction { agentProposalId } = do
|
||||
proposal <- fetch agentProposalId
|
||||
mExisting <- query @AgentReviewRecord
|
||||
|> filterWhere (#proposalId, agentProposalId)
|
||||
|> fetchOneOrNothing
|
||||
case mExisting of
|
||||
Just _ -> do
|
||||
setSuccessMessage "Already reviewed"
|
||||
redirectTo ShowAgentProposalAction { agentProposalId }
|
||||
Nothing -> do
|
||||
mUser <- currentUserOrNothing
|
||||
let reviewerId = fmap (.id) mUser
|
||||
proposal
|
||||
|> set #status "accepted"
|
||||
|> updateRecord
|
||||
notes <- paramOrNothing @Text "notes"
|
||||
newRecord @AgentReviewRecord
|
||||
|> set #proposalId agentProposalId
|
||||
|> set #reviewerId (fmap (Id . unId) reviewerId)
|
||||
|> set #decision "accepted"
|
||||
|> set #notes notes
|
||||
|> createRecord
|
||||
-- T04: if requirement_draft, promote to RequirementCandidate
|
||||
when (proposal.proposalType == "requirement_draft") do
|
||||
let mParsed = decode (fromStrict (encodeUtf8 proposal.content))
|
||||
:: Maybe (HashMap Text Text)
|
||||
case mParsed of
|
||||
Just m -> do
|
||||
let title = fromMaybe "AI Draft" (HashMap.lookup "title" m)
|
||||
desc = fromMaybe "" (HashMap.lookup "description" m)
|
||||
newRecord @RequirementCandidate
|
||||
|> set #title title
|
||||
|> set #description desc
|
||||
|> set #sourceWidgetId proposal.sourceWidgetId
|
||||
|> set #category "friction"
|
||||
|> set #status "open"
|
||||
|> createRecord
|
||||
setSuccessMessage "Requirement candidate created from AI draft"
|
||||
Nothing ->
|
||||
setSuccessMessage "Proposal accepted (could not parse JSON for candidate)"
|
||||
redirectTo ShowAgentProposalAction { agentProposalId }
|
||||
|
||||
action RejectProposalAction { agentProposalId } = do
|
||||
proposal <- fetch agentProposalId
|
||||
mExisting <- query @AgentReviewRecord
|
||||
|> filterWhere (#proposalId, agentProposalId)
|
||||
|> fetchOneOrNothing
|
||||
case mExisting of
|
||||
Just _ -> do
|
||||
setSuccessMessage "Already reviewed"
|
||||
redirectTo ShowAgentProposalAction { agentProposalId }
|
||||
Nothing -> do
|
||||
mUser <- currentUserOrNothing
|
||||
let reviewerId = fmap (.id) mUser
|
||||
proposal
|
||||
|> set #status "rejected"
|
||||
|> updateRecord
|
||||
notes <- paramOrNothing @Text "notes"
|
||||
newRecord @AgentReviewRecord
|
||||
|> set #proposalId agentProposalId
|
||||
|> set #reviewerId (fmap (Id . unId) reviewerId)
|
||||
|> set #decision "rejected"
|
||||
|> set #notes notes
|
||||
|> createRecord
|
||||
setSuccessMessage "Proposal rejected"
|
||||
redirectTo ShowAgentProposalAction { agentProposalId }
|
||||
@@ -8,6 +8,8 @@ import Web.View.DecisionRecords.Edit
|
||||
import Generated.Types
|
||||
import IHP.Prelude
|
||||
import IHP.ControllerPrelude
|
||||
import Application.Helper.Controller (callClaudeApi)
|
||||
import Data.List (intercalate)
|
||||
|
||||
validOutcomes :: [Text]
|
||||
validOutcomes = ["accepted", "rejected", "deferred", "split", "merged", "reframed"]
|
||||
@@ -175,3 +177,38 @@ instance Controller DecisionRecordsController where
|
||||
deleteRecord ref
|
||||
setSuccessMessage "Implementation reference removed"
|
||||
redirectTo ShowDecisionRecordAction { decisionRecordId }
|
||||
|
||||
-- T07: Propose implementation paths via Claude API
|
||||
action ProposeImplementationAction { decisionRecordId } = do
|
||||
record <- fetch decisionRecordId
|
||||
implRefs <- query @ImplementationChangeReference
|
||||
|> filterWhere (#decisionId, decisionRecordId)
|
||||
|> fetch
|
||||
mRequirement <- case record.requirementId of
|
||||
Nothing -> pure Nothing
|
||||
Just rid -> fetchOneOrNothing rid
|
||||
let implLines = map (\r -> r.system <> ": " <> r.workItemRef) implRefs
|
||||
reqDesc = maybe "" (.description) mRequirement
|
||||
userMsg = "Decision: " <> record.title
|
||||
<> "\nRationale: " <> record.rationale
|
||||
<> "\nOutcome: " <> record.outcome
|
||||
<> "\nRequirement: " <> reqDesc
|
||||
<> "\nExisting impl refs: " <> intercalate ", " implLines
|
||||
result <- liftIO $ callClaudeApi
|
||||
"You are a traceability-aware implementation analyst. Propose 1\x20133 concrete implementation paths for this decision. Each path should include a work_item_ref (e.g. PROJ-123), a system (github|linear|jira), and a rationale. Respond with JSON: {\"proposals\": [{\"work_item_ref\": \"...\", \"system\": \"...\", \"rationale\": \"...\"}]}."
|
||||
userMsg
|
||||
600
|
||||
case result of
|
||||
Left err -> do
|
||||
setErrorMessage ("Implementation proposal failed: " <> err)
|
||||
redirectTo ShowDecisionRecordAction { decisionRecordId }
|
||||
Right content -> do
|
||||
newRecord @AgentProposal
|
||||
|> set #proposalType "impl_proposal"
|
||||
|> set #sourceDecisionId (Just decisionRecordId)
|
||||
|> set #content content
|
||||
|> set #modelRef "claude-sonnet-4-6"
|
||||
|> set #status "pending"
|
||||
|> createRecord
|
||||
setSuccessMessage "Implementation proposal created"
|
||||
redirectTo ShowDecisionRecordAction { decisionRecordId }
|
||||
|
||||
@@ -8,6 +8,7 @@ import Web.View.Hubs.Edit
|
||||
import Web.View.Hubs.TriageDashboard
|
||||
import Web.View.Hubs.GovernanceDashboard
|
||||
import Web.View.Hubs.AntifragilityDashboard
|
||||
import Web.View.Hubs.AgentAuditDashboard
|
||||
import Generated.Types
|
||||
import IHP.Prelude
|
||||
import IHP.ControllerPrelude
|
||||
@@ -219,3 +220,11 @@ instance Controller HubsController where
|
||||
, regressionWidgetIds
|
||||
, recurrenceLeaderboard
|
||||
}
|
||||
action AgentAuditDashboardAction { hubId } = autoRefresh do
|
||||
hub <- fetch hubId
|
||||
proposals <- query @AgentProposal
|
||||
|> orderByDesc #createdAt
|
||||
|> fetch
|
||||
reviews <- query @AgentReviewRecord |> fetch
|
||||
widgets <- query @Widget |> fetch
|
||||
render AgentAuditDashboardView { hub, proposals, reviews, widgets }
|
||||
|
||||
@@ -8,6 +8,17 @@ import Web.View.RequirementCandidates.Edit
|
||||
import Generated.Types
|
||||
import IHP.Prelude
|
||||
import IHP.ControllerPrelude
|
||||
import Application.Helper.Controller (callClaudeApi)
|
||||
import Data.List (intercalate)
|
||||
import Data.Aeson (decode, Value(..), Array)
|
||||
import Data.Aeson.Lens (key, _String)
|
||||
import Control.Lens ((^?))
|
||||
import Data.ByteString.Lazy (fromStrict)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import qualified Data.Vector as Vector
|
||||
import Control.Monad (forM_)
|
||||
|
||||
validStatuses :: [Text]
|
||||
validStatuses = ["open", "in_review", "accepted", "rejected", "deferred"]
|
||||
@@ -233,3 +244,86 @@ instance Controller RequirementCandidatesController where
|
||||
|> createRecord
|
||||
setSuccessMessage "Decision record created"
|
||||
redirectTo ShowDecisionRecordAction { decisionRecordId = dr.id }
|
||||
|
||||
-- T05: Detect duplicate candidates via Claude API
|
||||
action DetectDuplicatesAction { requirementCandidateId } = do
|
||||
target <- fetch requirementCandidateId
|
||||
others <- query @RequirementCandidate
|
||||
|> fetch
|
||||
let otherLines = map (\c -> show c.id <> " | " <> c.title <> ": " <> c.description)
|
||||
(filter (\c -> c.id /= requirementCandidateId) others)
|
||||
targetLine = "TARGET: " <> target.title <> ": " <> target.description
|
||||
userMsg = targetLine <> "\n\nEXISTING:\n" <> intercalate "\n" otherLines
|
||||
result <- liftIO $ callClaudeApi
|
||||
"You are a deduplication assistant. Given a target candidate and a list of existing candidates, identify likely duplicates. Respond with JSON: {\"duplicates\": [{\"id\": \"uuid\", \"reason\": \"...\"}]}."
|
||||
userMsg
|
||||
500
|
||||
case result of
|
||||
Left err -> do
|
||||
setErrorMessage ("Duplicate detection failed: " <> err)
|
||||
redirectTo ShowRequirementCandidateAction { requirementCandidateId }
|
||||
Right content -> do
|
||||
newRecord @AgentProposal
|
||||
|> set #proposalType "duplicate_flag"
|
||||
|> set #sourceCandidateId (Just requirementCandidateId)
|
||||
|> set #content content
|
||||
|> set #modelRef "claude-sonnet-4-6"
|
||||
|> set #status "pending"
|
||||
|> createRecord
|
||||
setSuccessMessage "Duplicate detection proposal created"
|
||||
redirectTo ShowRequirementCandidateAction { requirementCandidateId }
|
||||
|
||||
-- T06: Detect policy sensitivity via Claude API
|
||||
action DetectPolicySensitivityAction { requirementCandidateId } = do
|
||||
candidate <- fetch requirementCandidateId
|
||||
mWidget <- case candidate.sourceWidgetId of
|
||||
Nothing -> pure Nothing
|
||||
Just wid -> fetchOneOrNothing wid
|
||||
let policyCtx = maybe "unknown" (.policyScope) mWidget
|
||||
userMsg = "Title: " <> candidate.title
|
||||
<> "\nDescription: " <> candidate.description
|
||||
<> "\nPolicy scope context: " <> policyCtx
|
||||
result <- liftIO $ callClaudeApi
|
||||
"You are a policy compliance assistant. Analyse this requirement candidate for potential policy concerns. Valid scopes: internal, external, regulatory, contractual, architectural. Respond with JSON: {\"concerns\": [{\"scope\": \"...\", \"note\": \"...\"}], \"severity\": \"low|medium|high\"}."
|
||||
userMsg
|
||||
500
|
||||
case result of
|
||||
Left err -> do
|
||||
setErrorMessage ("Policy check failed: " <> err)
|
||||
redirectTo ShowRequirementCandidateAction { requirementCandidateId }
|
||||
Right content -> do
|
||||
let confidenceScore = extractSeverityScore content
|
||||
proposal <- newRecord @AgentProposal
|
||||
|> set #proposalType "policy_flag"
|
||||
|> set #sourceCandidateId (Just requirementCandidateId)
|
||||
|> set #content content
|
||||
|> set #modelRef "claude-sonnet-4-6"
|
||||
|> set #confidence (Just confidenceScore)
|
||||
|> set #status "pending"
|
||||
|> createRecord
|
||||
-- Create one ConfidenceAnnotation per concern scope
|
||||
let mParsed = decode (fromStrict (encodeUtf8 content))
|
||||
:: Maybe (HashMap Text Value)
|
||||
case mParsed >>= HashMap.lookup "concerns" of
|
||||
Just (Array concerns) ->
|
||||
forM_ (Vector.toList concerns) \concern ->
|
||||
case (concern ^? key "scope" . _String
|
||||
,concern ^? key "note" . _String) of
|
||||
(Just scope, noteM) ->
|
||||
newRecord @ConfidenceAnnotation
|
||||
|> set #proposalId proposal.id
|
||||
|> set #dimension scope
|
||||
|> set #score confidenceScore
|
||||
|> set #explanation noteM
|
||||
|> createRecord
|
||||
_ -> pure ()
|
||||
_ -> pure ()
|
||||
setSuccessMessage "Policy check proposal created"
|
||||
redirectTo ShowRequirementCandidateAction { requirementCandidateId }
|
||||
|
||||
-- Map severity string to numeric confidence
|
||||
extractSeverityScore :: Text -> Double
|
||||
extractSeverityScore content
|
||||
| "\"high\"" `isInfixOf` content = 0.9
|
||||
| "\"medium\"" `isInfixOf` content = 0.6
|
||||
| otherwise = 0.3
|
||||
|
||||
@@ -9,7 +9,8 @@ import Generated.Types
|
||||
import IHP.Prelude
|
||||
import IHP.ControllerPrelude
|
||||
import Data.Aeson (toJSON, object, (.=))
|
||||
import Application.Helper.Controller (isInRegression, widgetCycleCounts)
|
||||
import Application.Helper.Controller (isInRegression, widgetCycleCounts, callClaudeApi)
|
||||
import Data.List (intercalate)
|
||||
|
||||
instance Controller WidgetsController where
|
||||
beforeAction = ensureIsUser
|
||||
@@ -121,3 +122,65 @@ instance Controller WidgetsController where
|
||||
|> createRecord
|
||||
setSuccessMessage "Widget updated"
|
||||
redirectTo ShowWidgetAction { widgetId = widget.id }
|
||||
|
||||
-- T03: Summarize feedback cluster via Claude API
|
||||
action SummarizeClusterAction { widgetId } = do
|
||||
annotations <- query @Annotation
|
||||
|> filterWhere (#widgetId, widgetId)
|
||||
|> orderByDesc #createdAt
|
||||
|> limit 20
|
||||
|> fetch
|
||||
threads <- query @AnnotationThread
|
||||
|> filterWhere (#widgetId, widgetId)
|
||||
|> orderByDesc #createdAt
|
||||
|> limit 20
|
||||
|> fetch
|
||||
let annLines = map (\a -> "[" <> a.category <> "/" <> a.severity <> "] " <> a.body) annotations
|
||||
threadLines = map (\t -> "[thread] " <> t.title <> ": " <> fromMaybe "" t.description) threads
|
||||
userMsg = intercalate "\n" (annLines <> threadLines)
|
||||
result <- liftIO $ callClaudeApi
|
||||
"You are a distillation assistant for a governed interaction hub. Summarize the following user feedback cluster into a concise, actionable summary (2\x20134 sentences). Be factual and neutral."
|
||||
userMsg
|
||||
300
|
||||
case result of
|
||||
Left err -> do
|
||||
setErrorMessage ("AI summarization failed: " <> err)
|
||||
redirectTo ShowWidgetAction { widgetId }
|
||||
Right content -> do
|
||||
newRecord @AgentProposal
|
||||
|> set #proposalType "summary"
|
||||
|> set #sourceWidgetId (Just widgetId)
|
||||
|> set #content content
|
||||
|> set #modelRef "claude-sonnet-4-6"
|
||||
|> set #status "pending"
|
||||
|> createRecord
|
||||
setSuccessMessage "Summary proposal created"
|
||||
redirectTo ShowWidgetAction { widgetId }
|
||||
|
||||
-- T04: Draft a requirement candidate via Claude API
|
||||
action DraftRequirementAction { widgetId } = do
|
||||
annotations <- query @Annotation
|
||||
|> filterWhere (#widgetId, widgetId)
|
||||
|> orderByDesc #createdAt
|
||||
|> limit 20
|
||||
|> fetch
|
||||
let annLines = map (\a -> "[" <> a.category <> "/" <> a.severity <> "] " <> a.body) annotations
|
||||
userMsg = intercalate "\n" annLines
|
||||
result <- liftIO $ callClaudeApi
|
||||
"You are a requirements analyst. Given these friction annotations, draft a single structured requirement candidate. Respond with JSON: {\"title\": \"...\", \"description\": \"...\"}."
|
||||
userMsg
|
||||
400
|
||||
case result of
|
||||
Left err -> do
|
||||
setErrorMessage ("AI draft failed: " <> err)
|
||||
redirectTo ShowWidgetAction { widgetId }
|
||||
Right content -> do
|
||||
newRecord @AgentProposal
|
||||
|> set #proposalType "requirement_draft"
|
||||
|> set #sourceWidgetId (Just widgetId)
|
||||
|> set #content content
|
||||
|> set #modelRef "claude-sonnet-4-6"
|
||||
|> set #status "pending"
|
||||
|> createRecord
|
||||
setSuccessMessage "Requirement draft proposal created"
|
||||
redirectTo ShowWidgetAction { widgetId }
|
||||
|
||||
@@ -16,6 +16,7 @@ import Web.Controller.RequirementCandidates ()
|
||||
import Web.Controller.Requirements ()
|
||||
import Web.Controller.DecisionRecords ()
|
||||
import Web.Controller.DeploymentRecords ()
|
||||
import Web.Controller.AgentProposals ()
|
||||
import Web.Controller.Sessions ()
|
||||
|
||||
instance FrontController WebApplication where
|
||||
@@ -30,6 +31,7 @@ instance FrontController WebApplication where
|
||||
, parseRoute @RequirementsController
|
||||
, parseRoute @DecisionRecordsController
|
||||
, parseRoute @DeploymentRecordsController
|
||||
, parseRoute @AgentProposalsController
|
||||
]
|
||||
|
||||
instance InitControllerContext WebApplication where
|
||||
@@ -59,6 +61,7 @@ defaultLayout inner = [hsx|
|
||||
<a href={RequirementsAction} class="text-sm text-gray-600 hover:text-gray-900">Requirements</a>
|
||||
<a href={DecisionRecordsAction} class="text-sm text-gray-600 hover:text-gray-900">Decisions</a>
|
||||
<a href={DeploymentRecordsAction} class="text-sm text-gray-600 hover:text-gray-900">Deployments</a>
|
||||
<a href={AgentProposalsAction} class="text-sm text-gray-600 hover:text-gray-900">Agent</a>
|
||||
<div class="ml-auto">
|
||||
<a href={DeleteSessionAction} class="text-sm text-gray-500 hover:text-gray-700">Sign out</a>
|
||||
</div>
|
||||
|
||||
@@ -31,5 +31,8 @@ instance AutoRoute DecisionRecordsController
|
||||
-- Deployment Records (Phase 4)
|
||||
instance AutoRoute DeploymentRecordsController
|
||||
|
||||
-- Agent Proposals (Phase 5)
|
||||
instance AutoRoute AgentProposalsController
|
||||
|
||||
-- Sessions
|
||||
instance AutoRoute SessionsController
|
||||
|
||||
21
Web/Types.hs
21
Web/Types.hs
@@ -26,6 +26,7 @@ data HubsController
|
||||
| TriageDashboardAction { hubId :: !(Id Hub) }
|
||||
| GovernanceDashboardAction { hubId :: !(Id Hub) }
|
||||
| AntifragilityDashboardAction { hubId :: !(Id Hub) }
|
||||
| AgentAuditDashboardAction { hubId :: !(Id Hub) }
|
||||
deriving (Eq, Show, Data)
|
||||
|
||||
data WidgetsController
|
||||
@@ -33,8 +34,10 @@ data WidgetsController
|
||||
| NewWidgetAction
|
||||
| ShowWidgetAction { widgetId :: !(Id Widget) }
|
||||
| CreateWidgetAction
|
||||
| EditWidgetAction { widgetId :: !(Id Widget) }
|
||||
| UpdateWidgetAction { widgetId :: !(Id Widget) }
|
||||
| EditWidgetAction { widgetId :: !(Id Widget) }
|
||||
| UpdateWidgetAction { widgetId :: !(Id Widget) }
|
||||
| SummarizeClusterAction { widgetId :: !(Id Widget) }
|
||||
| DraftRequirementAction { widgetId :: !(Id Widget) }
|
||||
deriving (Eq, Show, Data)
|
||||
|
||||
data InteractionEventsController
|
||||
@@ -67,8 +70,10 @@ data RequirementCandidatesController
|
||||
| UpdateTriageStatusAction { requirementCandidateId :: !(Id RequirementCandidate) }
|
||||
| AssignReviewerAction { requirementCandidateId :: !(Id RequirementCandidate) }
|
||||
| MyQueueAction
|
||||
| PromoteToRequirementAction { requirementCandidateId :: !(Id RequirementCandidate) }
|
||||
| LinkToDecisionAction { requirementCandidateId :: !(Id RequirementCandidate) }
|
||||
| PromoteToRequirementAction { requirementCandidateId :: !(Id RequirementCandidate) }
|
||||
| LinkToDecisionAction { requirementCandidateId :: !(Id RequirementCandidate) }
|
||||
| DetectDuplicatesAction { requirementCandidateId :: !(Id RequirementCandidate) }
|
||||
| DetectPolicySensitivityAction { requirementCandidateId :: !(Id RequirementCandidate) }
|
||||
deriving (Eq, Show, Data)
|
||||
|
||||
data RequirementsController
|
||||
@@ -87,6 +92,7 @@ data DecisionRecordsController
|
||||
| DeletePolicyReferenceAction { policyReferenceId :: !(Id PolicyReference) }
|
||||
| AddImplementationRefAction { decisionRecordId :: !(Id DecisionRecord) }
|
||||
| DeleteImplementationRefAction { implementationChangeReferenceId :: !(Id ImplementationChangeReference) }
|
||||
| ProposeImplementationAction { decisionRecordId :: !(Id DecisionRecord) }
|
||||
deriving (Eq, Show, Data)
|
||||
|
||||
data DeploymentRecordsController
|
||||
@@ -98,6 +104,13 @@ data DeploymentRecordsController
|
||||
| EvaluateChangeAction { deploymentRecordId :: !(Id DeploymentRecord) }
|
||||
deriving (Eq, Show, Data)
|
||||
|
||||
data AgentProposalsController
|
||||
= AgentProposalsAction
|
||||
| ShowAgentProposalAction { agentProposalId :: !(Id AgentProposal) }
|
||||
| AcceptProposalAction { agentProposalId :: !(Id AgentProposal) }
|
||||
| RejectProposalAction { agentProposalId :: !(Id AgentProposal) }
|
||||
deriving (Eq, Show, Data)
|
||||
|
||||
data SessionsController
|
||||
= NewSessionAction
|
||||
| CreateSessionAction
|
||||
|
||||
138
Web/View/AgentProposals/Index.hs
Normal file
138
Web/View/AgentProposals/Index.hs
Normal file
@@ -0,0 +1,138 @@
|
||||
module Web.View.AgentProposals.Index where
|
||||
|
||||
import Web.Types
|
||||
import Generated.Types
|
||||
import IHP.Prelude
|
||||
import IHP.ViewPrelude
|
||||
|
||||
data IndexView = IndexView
|
||||
{ proposals :: ![AgentProposal]
|
||||
, widgets :: ![Widget]
|
||||
, mTypeFilter :: !(Maybe Text)
|
||||
, mStatusFilter :: !(Maybe Text)
|
||||
}
|
||||
|
||||
allProposalTypes :: [Text]
|
||||
allProposalTypes = ["summary", "requirement_draft", "duplicate_flag", "policy_flag", "impl_proposal"]
|
||||
|
||||
allStatuses :: [Text]
|
||||
allStatuses = ["pending", "accepted", "rejected", "superseded"]
|
||||
|
||||
instance View IndexView where
|
||||
html IndexView { .. } = [hsx|
|
||||
<div class="flex items-center justify-between mb-6">
|
||||
<h1 class="text-2xl font-semibold">Agent Proposals</h1>
|
||||
</div>
|
||||
|
||||
<!-- Filters -->
|
||||
<div class="flex gap-4 mb-5 flex-wrap">
|
||||
<div class="flex gap-1 text-sm flex-wrap">
|
||||
<span class="text-gray-400 text-xs self-center mr-1">Type:</span>
|
||||
<a href={agentProposalsUrl Nothing mStatusFilter}
|
||||
class={typeTabClass Nothing mTypeFilter}>All</a>
|
||||
{forEach allProposalTypes (\t -> [hsx|
|
||||
<a href={agentProposalsUrl (Just t) mStatusFilter}
|
||||
class={typeTabClass (Just t) mTypeFilter}>{t}</a>
|
||||
|])}
|
||||
</div>
|
||||
<div class="flex gap-1 text-sm flex-wrap">
|
||||
<span class="text-gray-400 text-xs self-center mr-1">Status:</span>
|
||||
<a href={agentProposalsUrl mTypeFilter Nothing}
|
||||
class={typeTabClass Nothing mStatusFilter}>All</a>
|
||||
{forEach allStatuses (\s -> [hsx|
|
||||
<a href={agentProposalsUrl mTypeFilter (Just s)}
|
||||
class={typeTabClass (Just s) mStatusFilter}>{s}</a>
|
||||
|])}
|
||||
</div>
|
||||
</div>
|
||||
|
||||
{if null proposals
|
||||
then [hsx|<p class="text-sm text-gray-400">No proposals found.</p>|]
|
||||
else renderTable proposals widgets}
|
||||
|]
|
||||
|
||||
agentProposalsUrl :: Maybe Text -> Maybe Text -> Text
|
||||
agentProposalsUrl mt ms =
|
||||
let parts = catMaybes
|
||||
[ fmap ("proposal_type=" <>) mt
|
||||
, fmap ("status=" <>) ms
|
||||
]
|
||||
in "/AgentProposals" <> if null parts then "" else "?" <> intercalate "&" parts
|
||||
|
||||
renderTable :: [AgentProposal] -> [Widget] -> Html
|
||||
renderTable proposals widgets = [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-600">Type</th>
|
||||
<th class="text-left px-4 py-3 font-medium text-gray-600">Source Widget</th>
|
||||
<th class="text-left px-4 py-3 font-medium text-gray-600">Confidence</th>
|
||||
<th class="text-left px-4 py-3 font-medium text-gray-600">Status</th>
|
||||
<th class="text-left px-4 py-3 font-medium text-gray-600">Created</th>
|
||||
</tr>
|
||||
</thead>
|
||||
<tbody class="divide-y divide-gray-100">
|
||||
{forEach proposals (renderRow widgets)}
|
||||
</tbody>
|
||||
</table>
|
||||
</div>
|
||||
|]
|
||||
|
||||
renderRow :: [Widget] -> AgentProposal -> Html
|
||||
renderRow widgets p = [hsx|
|
||||
<tr class="hover:bg-gray-50">
|
||||
<td class="px-4 py-3">
|
||||
<a href={ShowAgentProposalAction { agentProposalId = p.id }}
|
||||
class={proposalTypeBadge p.proposalType <> " text-xs px-2 py-0.5 rounded font-medium"}>
|
||||
{p.proposalType}
|
||||
</a>
|
||||
</td>
|
||||
<td class="px-4 py-3 text-gray-600">{widgetName widgets p.sourceWidgetId}</td>
|
||||
<td class="px-4 py-3">{renderConfidenceBar p.confidence}</td>
|
||||
<td class="px-4 py-3">
|
||||
<span class={statusBadge p.status <> " text-xs px-2 py-0.5 rounded font-medium"}>
|
||||
{p.status}
|
||||
</span>
|
||||
</td>
|
||||
<td class="px-4 py-3 text-gray-400 text-xs">{show p.createdAt}</td>
|
||||
</tr>
|
||||
|]
|
||||
|
||||
widgetName :: [Widget] -> Maybe (Id Widget) -> Text
|
||||
widgetName _ Nothing = "—"
|
||||
widgetName widgets (Just wid) = maybe "(unknown)" (.name) (find (\w -> w.id == wid) widgets)
|
||||
|
||||
renderConfidenceBar :: Maybe Double -> Html
|
||||
renderConfidenceBar Nothing = [hsx|<span class="text-gray-300 text-xs">—</span>|]
|
||||
renderConfidenceBar (Just c) =
|
||||
let pct = show (round (c * 100) :: Int) <> "%"
|
||||
barWidth = "width: " <> pct
|
||||
in [hsx|
|
||||
<div class="flex items-center gap-2">
|
||||
<div class="w-16 bg-gray-100 rounded h-1.5">
|
||||
<div class="bg-indigo-400 rounded h-1.5" style={barWidth}></div>
|
||||
</div>
|
||||
<span class="text-xs text-gray-500">{pct}</span>
|
||||
</div>
|
||||
|]
|
||||
|
||||
proposalTypeBadge :: Text -> Text
|
||||
proposalTypeBadge "summary" = "bg-blue-100 text-blue-800"
|
||||
proposalTypeBadge "requirement_draft" = "bg-indigo-100 text-indigo-800"
|
||||
proposalTypeBadge "duplicate_flag" = "bg-orange-100 text-orange-800"
|
||||
proposalTypeBadge "policy_flag" = "bg-red-100 text-red-800"
|
||||
proposalTypeBadge "impl_proposal" = "bg-green-100 text-green-800"
|
||||
proposalTypeBadge _ = "bg-gray-100 text-gray-600"
|
||||
|
||||
statusBadge :: Text -> Text
|
||||
statusBadge "pending" = "bg-yellow-100 text-yellow-800"
|
||||
statusBadge "accepted" = "bg-green-100 text-green-800"
|
||||
statusBadge "rejected" = "bg-red-100 text-red-800"
|
||||
statusBadge "superseded" = "bg-gray-100 text-gray-500"
|
||||
statusBadge _ = "bg-gray-100 text-gray-600"
|
||||
|
||||
typeTabClass :: Maybe Text -> Maybe Text -> Text
|
||||
typeTabClass a b
|
||||
| a == b = "px-3 py-1 rounded bg-indigo-100 text-indigo-700 font-medium text-xs"
|
||||
| otherwise = "px-3 py-1 rounded text-gray-600 hover:bg-gray-100 text-xs"
|
||||
165
Web/View/AgentProposals/Show.hs
Normal file
165
Web/View/AgentProposals/Show.hs
Normal file
@@ -0,0 +1,165 @@
|
||||
module Web.View.AgentProposals.Show where
|
||||
|
||||
import Web.Types
|
||||
import Generated.Types
|
||||
import IHP.Prelude
|
||||
import IHP.ViewPrelude
|
||||
|
||||
data ShowView = ShowView
|
||||
{ proposal :: !AgentProposal
|
||||
, mWidget :: !(Maybe Widget)
|
||||
, mCandidate :: !(Maybe RequirementCandidate)
|
||||
, mDecision :: !(Maybe DecisionRecord)
|
||||
, mReview :: !(Maybe AgentReviewRecord)
|
||||
, confidences :: ![ConfidenceAnnotation]
|
||||
, users :: ![User]
|
||||
}
|
||||
|
||||
instance View ShowView where
|
||||
html ShowView { .. } = [hsx|
|
||||
<div class="mb-4">
|
||||
<a href={AgentProposalsAction} class="text-sm text-indigo-600 hover:underline">← Agent Proposals</a>
|
||||
</div>
|
||||
|
||||
<div class="flex items-start justify-between mb-6">
|
||||
<div class="flex items-center gap-3">
|
||||
<span class={proposalTypeBadge proposal.proposalType <> " text-sm px-2 py-1 rounded font-medium"}>
|
||||
{proposal.proposalType}
|
||||
</span>
|
||||
<span class={statusBadge proposal.status <> " text-sm px-2 py-1 rounded font-medium"}>
|
||||
{proposal.status}
|
||||
</span>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
<!-- Content panel -->
|
||||
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-5">
|
||||
<h2 class="text-sm font-semibold text-gray-700 mb-2">AI Output</h2>
|
||||
<pre class="text-sm text-gray-800 whitespace-pre-wrap font-mono bg-gray-50 rounded p-4">{proposal.content}</pre>
|
||||
</div>
|
||||
|
||||
<!-- Confidence breakdown -->
|
||||
{if null confidences then mempty else renderConfidences confidences}
|
||||
|
||||
<!-- Source context -->
|
||||
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-5">
|
||||
<h2 class="text-sm font-semibold text-gray-700 mb-3">Source Context</h2>
|
||||
<dl class="grid grid-cols-2 gap-3 text-sm">
|
||||
<dt class="text-gray-500">Widget</dt>
|
||||
<dd>{maybe "—" (.name) mWidget}</dd>
|
||||
<dt class="text-gray-500">Candidate</dt>
|
||||
<dd>{maybe "—" (.title) mCandidate}</dd>
|
||||
<dt class="text-gray-500">Decision</dt>
|
||||
<dd>{maybe "—" (.title) mDecision}</dd>
|
||||
</dl>
|
||||
</div>
|
||||
|
||||
<!-- Review section -->
|
||||
{case mReview of
|
||||
Just review -> renderExistingReview review users
|
||||
Nothing -> renderReviewForm proposal.id proposal.status}
|
||||
|
||||
<!-- Attribution footer -->
|
||||
<div class="text-xs text-gray-400 mt-4 border-t pt-3">
|
||||
Model: <span class="font-mono">{proposal.modelRef}</span>
|
||||
· Created: {show proposal.createdAt}
|
||||
</div>
|
||||
|]
|
||||
|
||||
renderConfidences :: [ConfidenceAnnotation] -> Html
|
||||
renderConfidences cs = [hsx|
|
||||
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-5">
|
||||
<h2 class="text-sm font-semibold text-gray-700 mb-3">Confidence Breakdown</h2>
|
||||
<div class="space-y-3">
|
||||
{forEach cs renderConfidenceRow}
|
||||
</div>
|
||||
</div>
|
||||
|]
|
||||
|
||||
renderConfidenceRow :: ConfidenceAnnotation -> Html
|
||||
renderConfidenceRow c =
|
||||
let pct = show (round (c.score * 100) :: Int) <> "%"
|
||||
barWidth = "width: " <> pct
|
||||
in [hsx|
|
||||
<div>
|
||||
<div class="flex justify-between text-xs mb-1">
|
||||
<span class="text-gray-600">{c.dimension}</span>
|
||||
<span class="text-gray-500">{pct}</span>
|
||||
</div>
|
||||
<div class="w-full bg-gray-100 rounded h-2">
|
||||
<div class="bg-indigo-400 rounded h-2" style={barWidth}></div>
|
||||
</div>
|
||||
{maybe mempty (\e -> [hsx|<p class="text-xs text-gray-400 mt-0.5">{e}</p>|]) c.explanation}
|
||||
</div>
|
||||
|]
|
||||
|
||||
renderExistingReview :: AgentReviewRecord -> [User] -> Html
|
||||
renderExistingReview review users = [hsx|
|
||||
<div class="bg-gray-50 rounded-lg border border-gray-200 p-5 mb-5">
|
||||
<h2 class="text-sm font-semibold text-gray-700 mb-2">Review Decision</h2>
|
||||
<div class="flex items-center gap-3 mb-2">
|
||||
<span class={decisionBadge review.decision <> " text-sm px-2 py-1 rounded font-medium"}>
|
||||
{review.decision}
|
||||
</span>
|
||||
<span class="text-xs text-gray-400">by {reviewerName users review.reviewerId} at {show review.reviewedAt}</span>
|
||||
</div>
|
||||
{maybe mempty (\n -> [hsx|<p class="text-sm text-gray-600">{n}</p>|]) review.notes}
|
||||
</div>
|
||||
|]
|
||||
|
||||
renderReviewForm :: Id AgentProposal -> Text -> Html
|
||||
renderReviewForm pid status
|
||||
| status /= "pending" = mempty
|
||||
| otherwise = [hsx|
|
||||
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-5">
|
||||
<h2 class="text-sm font-semibold text-gray-700 mb-3">Review This Proposal</h2>
|
||||
<div class="mb-3">
|
||||
<label class="block text-xs text-gray-500 mb-1">Notes (optional)</label>
|
||||
<textarea id="review-notes" name="notes" rows="2"
|
||||
class="w-full border border-gray-300 rounded px-3 py-2 text-sm"></textarea>
|
||||
</div>
|
||||
<div class="flex gap-3">
|
||||
<form method="POST" action={AcceptProposalAction { agentProposalId = pid }}
|
||||
onsubmit="document.getElementById('accept-notes').value = document.getElementById('review-notes').value">
|
||||
<input type="hidden" name="notes" id="accept-notes" />
|
||||
<button type="submit"
|
||||
class="bg-green-600 text-white text-sm px-4 py-2 rounded hover:bg-green-700">
|
||||
Accept
|
||||
</button>
|
||||
</form>
|
||||
<form method="POST" action={RejectProposalAction { agentProposalId = pid }}
|
||||
onsubmit="document.getElementById('reject-notes').value = document.getElementById('review-notes').value">
|
||||
<input type="hidden" name="notes" id="reject-notes" />
|
||||
<button type="submit"
|
||||
class="bg-red-600 text-white text-sm px-4 py-2 rounded hover:bg-red-700">
|
||||
Reject
|
||||
</button>
|
||||
</form>
|
||||
</div>
|
||||
</div>
|
||||
|]
|
||||
|
||||
reviewerName :: [User] -> Maybe (Id User) -> Text
|
||||
reviewerName _ Nothing = "unknown"
|
||||
reviewerName users (Just uid) = maybe "(unknown)" (.name) (find (\u -> u.id == uid) users)
|
||||
|
||||
proposalTypeBadge :: Text -> Text
|
||||
proposalTypeBadge "summary" = "bg-blue-100 text-blue-800"
|
||||
proposalTypeBadge "requirement_draft" = "bg-indigo-100 text-indigo-800"
|
||||
proposalTypeBadge "duplicate_flag" = "bg-orange-100 text-orange-800"
|
||||
proposalTypeBadge "policy_flag" = "bg-red-100 text-red-800"
|
||||
proposalTypeBadge "impl_proposal" = "bg-green-100 text-green-800"
|
||||
proposalTypeBadge _ = "bg-gray-100 text-gray-600"
|
||||
|
||||
statusBadge :: Text -> Text
|
||||
statusBadge "pending" = "bg-yellow-100 text-yellow-800"
|
||||
statusBadge "accepted" = "bg-green-100 text-green-800"
|
||||
statusBadge "rejected" = "bg-red-100 text-red-800"
|
||||
statusBadge "superseded" = "bg-gray-100 text-gray-500"
|
||||
statusBadge _ = "bg-gray-100 text-gray-600"
|
||||
|
||||
decisionBadge :: Text -> Text
|
||||
decisionBadge "accepted" = "bg-green-100 text-green-800"
|
||||
decisionBadge "rejected" = "bg-red-100 text-red-800"
|
||||
decisionBadge "modified" = "bg-blue-100 text-blue-800"
|
||||
decisionBadge _ = "bg-gray-100 text-gray-600"
|
||||
@@ -114,7 +114,14 @@ instance View ShowView where
|
||||
|
||||
<!-- Implementation references -->
|
||||
<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">Implementation References</h2>
|
||||
<div class="flex items-center justify-between mb-3">
|
||||
<h2 class="text-sm font-semibold text-gray-700">Implementation References</h2>
|
||||
<form method="POST" action={ProposeImplementationAction { decisionRecordId = record.id }} class="inline">
|
||||
<button type="submit" class="text-xs border border-green-300 text-green-700 px-2 py-1 rounded hover:bg-green-50">
|
||||
Propose Implementation
|
||||
</button>
|
||||
</form>
|
||||
</div>
|
||||
{forEach implRefs renderImplRef}
|
||||
<form method="POST" action={AddImplementationRefAction { decisionRecordId = record.id }}
|
||||
class="mt-3 flex items-end gap-2">
|
||||
|
||||
191
Web/View/Hubs/AgentAuditDashboard.hs
Normal file
191
Web/View/Hubs/AgentAuditDashboard.hs
Normal file
@@ -0,0 +1,191 @@
|
||||
module Web.View.Hubs.AgentAuditDashboard where
|
||||
|
||||
import Web.Types
|
||||
import Generated.Types
|
||||
import IHP.Prelude
|
||||
import IHP.ViewPrelude
|
||||
|
||||
data AgentAuditDashboardView = AgentAuditDashboardView
|
||||
{ hub :: !Hub
|
||||
, proposals :: ![AgentProposal]
|
||||
, reviews :: ![AgentReviewRecord]
|
||||
, widgets :: ![Widget]
|
||||
}
|
||||
|
||||
instance View AgentAuditDashboardView where
|
||||
html AgentAuditDashboardView { .. } = [hsx|
|
||||
<div class="flex items-center justify-between mb-6">
|
||||
<div>
|
||||
<h1 class="text-2xl font-semibold">Agent Audit Dashboard</h1>
|
||||
<p class="text-sm text-gray-500">{hub.name}</p>
|
||||
</div>
|
||||
<a href={ShowHubAction { hubId = hub.id }}
|
||||
class="text-sm text-indigo-600 hover:underline">← Hub</a>
|
||||
</div>
|
||||
|
||||
<!-- KPI row -->
|
||||
<div class="grid grid-cols-4 gap-4 mb-6">
|
||||
{kpiCard "Total Proposals" (show totalProposals) "text-gray-800"}
|
||||
{kpiCard "Pending" (show pendingCount) "text-yellow-700"}
|
||||
{kpiCard "Acceptance Rate" (showPct acceptanceRate) "text-green-700"}
|
||||
{kpiCard "Rejection Rate" (showPct rejectionRate) "text-red-700"}
|
||||
</div>
|
||||
|
||||
<!-- Proposals by type -->
|
||||
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-5">
|
||||
<h2 class="text-sm font-semibold text-gray-700 mb-3">Proposals by Type</h2>
|
||||
<div class="flex gap-4 flex-wrap">
|
||||
{forEach allTypes (\t ->
|
||||
let cnt = length (filter (\p -> p.proposalType == t) proposals)
|
||||
in [hsx|
|
||||
<div class="flex items-center gap-2">
|
||||
<span class={typeBadge t <> " text-xs px-2 py-0.5 rounded font-medium"}>{t}</span>
|
||||
<span class="text-sm font-semibold text-gray-700">{show cnt}</span>
|
||||
</div>
|
||||
|])}
|
||||
</div>
|
||||
</div>
|
||||
|
||||
<!-- Unreviewed queue -->
|
||||
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden mb-5">
|
||||
<div class="px-5 py-3 border-b border-gray-100 bg-yellow-50">
|
||||
<h2 class="text-sm font-semibold text-yellow-800">Unreviewed Queue ({show pendingCount})</h2>
|
||||
</div>
|
||||
{if null pending
|
||||
then [hsx|<p class="text-sm text-gray-400 px-5 py-4">No pending proposals.</p>|]
|
||||
else [hsx|
|
||||
<table class="w-full text-sm">
|
||||
<tbody class="divide-y divide-gray-100">
|
||||
{forEach (sortByCreatedAt pending) renderQueueRow}
|
||||
</tbody>
|
||||
</table>
|
||||
|]}
|
||||
</div>
|
||||
|
||||
<!-- Recent proposals (last 20) -->
|
||||
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden mb-5">
|
||||
<div class="px-5 py-3 border-b border-gray-100">
|
||||
<h2 class="text-sm font-semibold text-gray-700">Recent Proposals (last 20)</h2>
|
||||
</div>
|
||||
<table class="w-full text-sm">
|
||||
<thead class="bg-gray-50 border-b border-gray-200">
|
||||
<tr>
|
||||
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Type</th>
|
||||
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Source Widget</th>
|
||||
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Status</th>
|
||||
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Confidence</th>
|
||||
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Age</th>
|
||||
</tr>
|
||||
</thead>
|
||||
<tbody class="divide-y divide-gray-100">
|
||||
{forEach recent (renderRecentRow widgets)}
|
||||
</tbody>
|
||||
</table>
|
||||
</div>
|
||||
|
||||
<!-- Attribution log: model_ref x proposal_type matrix -->
|
||||
<div class="bg-white rounded-lg border border-gray-200 p-5">
|
||||
<h2 class="text-sm font-semibold text-gray-700 mb-3">Attribution Log (model × type)</h2>
|
||||
<table class="text-xs">
|
||||
<thead>
|
||||
<tr>
|
||||
<th class="text-left px-3 py-1 text-gray-500">Model</th>
|
||||
{forEach allTypes (\t -> [hsx|
|
||||
<th class="px-3 py-1 text-gray-500">{t}</th>
|
||||
|])}
|
||||
</tr>
|
||||
</thead>
|
||||
<tbody>
|
||||
{forEach allModels (\m -> [hsx|
|
||||
<tr class="border-t border-gray-100">
|
||||
<td class="px-3 py-1 font-mono text-gray-600">{m}</td>
|
||||
{forEach allTypes (\t ->
|
||||
let cnt = length (filter (\p -> p.modelRef == m && p.proposalType == t) proposals)
|
||||
in [hsx|<td class="px-3 py-1 text-center text-gray-700">{if cnt == 0 then "—" else show cnt}</td>|])}
|
||||
</tr>
|
||||
|])}
|
||||
</tbody>
|
||||
</table>
|
||||
</div>
|
||||
|]
|
||||
where
|
||||
totalProposals = length proposals
|
||||
pending = filter (\p -> p.status == "pending") proposals
|
||||
pendingCount = length pending
|
||||
accepted = filter (\r -> r.decision == "accepted") reviews
|
||||
rejected = filter (\r -> r.decision == "rejected") reviews
|
||||
reviewed = length accepted + length rejected
|
||||
acceptanceRate = if reviewed == 0 then 0 else fromIntegral (length accepted) / fromIntegral reviewed :: Double
|
||||
rejectionRate = if reviewed == 0 then 0 else fromIntegral (length rejected) / fromIntegral reviewed :: Double
|
||||
recent = take 20 proposals
|
||||
allTypes = ["summary", "requirement_draft", "duplicate_flag", "policy_flag", "impl_proposal"]
|
||||
allModels = nub (map (.modelRef) proposals)
|
||||
|
||||
kpiCard :: Text -> Text -> Text -> Html
|
||||
kpiCard label value colorClass = [hsx|
|
||||
<div class="bg-white rounded-lg border border-gray-200 p-4">
|
||||
<p class="text-xs text-gray-500 mb-1">{label}</p>
|
||||
<p class={"text-2xl font-bold " <> colorClass}>{value}</p>
|
||||
</div>
|
||||
|]
|
||||
|
||||
renderQueueRow :: AgentProposal -> Html
|
||||
renderQueueRow p = [hsx|
|
||||
<tr class="hover:bg-gray-50">
|
||||
<td class="px-4 py-2">
|
||||
<span class={typeBadge p.proposalType <> " text-xs px-2 py-0.5 rounded font-medium"}>
|
||||
{p.proposalType}
|
||||
</span>
|
||||
</td>
|
||||
<td class="px-4 py-2 text-gray-400 text-xs">{show p.createdAt}</td>
|
||||
<td class="px-4 py-2">
|
||||
<a href={ShowAgentProposalAction { agentProposalId = p.id }}
|
||||
class="text-xs text-indigo-600 hover:underline">Review →</a>
|
||||
</td>
|
||||
</tr>
|
||||
|]
|
||||
|
||||
renderRecentRow :: [Widget] -> AgentProposal -> Html
|
||||
renderRecentRow widgets p = [hsx|
|
||||
<tr class="hover:bg-gray-50">
|
||||
<td class="px-4 py-2">
|
||||
<a href={ShowAgentProposalAction { agentProposalId = p.id }}
|
||||
class={typeBadge p.proposalType <> " text-xs px-2 py-0.5 rounded font-medium"}>
|
||||
{p.proposalType}
|
||||
</a>
|
||||
</td>
|
||||
<td class="px-4 py-2 text-gray-600 text-xs">{widgetName widgets p.sourceWidgetId}</td>
|
||||
<td class="px-4 py-2">
|
||||
<span class={statusBadge p.status <> " text-xs px-2 py-0.5 rounded"}>
|
||||
{p.status}
|
||||
</span>
|
||||
</td>
|
||||
<td class="px-4 py-2 text-gray-500 text-xs">{maybe "—" (\c -> show (round (c * 100) :: Int) <> "%") p.confidence}</td>
|
||||
<td class="px-4 py-2 text-gray-400 text-xs">{show p.createdAt}</td>
|
||||
</tr>
|
||||
|]
|
||||
|
||||
widgetName :: [Widget] -> Maybe (Id Widget) -> Text
|
||||
widgetName _ Nothing = "—"
|
||||
widgetName widgets (Just wid) = maybe "—" (.name) (find (\w -> w.id == wid) widgets)
|
||||
|
||||
sortByCreatedAt :: [AgentProposal] -> [AgentProposal]
|
||||
sortByCreatedAt = sortBy (\a b -> compare a.createdAt b.createdAt)
|
||||
|
||||
showPct :: Double -> Text
|
||||
showPct d = show (round (d * 100) :: Int) <> "%"
|
||||
|
||||
typeBadge :: Text -> Text
|
||||
typeBadge "summary" = "bg-blue-100 text-blue-800"
|
||||
typeBadge "requirement_draft" = "bg-indigo-100 text-indigo-800"
|
||||
typeBadge "duplicate_flag" = "bg-orange-100 text-orange-800"
|
||||
typeBadge "policy_flag" = "bg-red-100 text-red-800"
|
||||
typeBadge "impl_proposal" = "bg-green-100 text-green-800"
|
||||
typeBadge _ = "bg-gray-100 text-gray-600"
|
||||
|
||||
statusBadge :: Text -> Text
|
||||
statusBadge "pending" = "bg-yellow-100 text-yellow-800"
|
||||
statusBadge "accepted" = "bg-green-100 text-green-800"
|
||||
statusBadge "rejected" = "bg-red-100 text-red-800"
|
||||
statusBadge "superseded" = "bg-gray-100 text-gray-500"
|
||||
statusBadge _ = "bg-gray-100 text-gray-600"
|
||||
@@ -41,6 +41,10 @@ instance View ShowView where
|
||||
class="text-sm border border-green-300 text-green-700 px-3 py-1.5 rounded hover:bg-green-50">
|
||||
Antifragility
|
||||
</a>
|
||||
<a href={AgentAuditDashboardAction { hubId = hub.id }}
|
||||
class="text-sm border border-purple-300 text-purple-700 px-3 py-1.5 rounded hover:bg-purple-50">
|
||||
Agent Audit
|
||||
</a>
|
||||
<a href={EditHubAction { hubId = hub.id }}
|
||||
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
|
||||
Edit
|
||||
|
||||
@@ -28,7 +28,17 @@ instance View ShowView where
|
||||
<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">
|
||||
<div class="flex gap-2 ml-4 flex-wrap">
|
||||
<form method="POST" action={DetectDuplicatesAction { requirementCandidateId = candidate.id }} class="inline">
|
||||
<button type="submit" class="text-sm border border-orange-300 text-orange-700 px-3 py-1.5 rounded hover:bg-orange-50">
|
||||
Check Duplicates
|
||||
</button>
|
||||
</form>
|
||||
<form method="POST" action={DetectPolicySensitivityAction { requirementCandidateId = candidate.id }} class="inline">
|
||||
<button type="submit" class="text-sm border border-red-300 text-red-700 px-3 py-1.5 rounded hover:bg-red-50">
|
||||
Policy Check
|
||||
</button>
|
||||
</form>
|
||||
<a href={EditRequirementCandidateAction { requirementCandidateId = candidate.id }}
|
||||
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
|
||||
Edit
|
||||
|
||||
@@ -82,8 +82,22 @@ instance View ShowView where
|
||||
<section>
|
||||
<div class="flex items-center justify-between mb-3">
|
||||
<h2 class="text-lg font-medium">Annotations</h2>
|
||||
<a href={NewAnnotationAction { widgetId = widget.id }}
|
||||
class="text-sm text-indigo-600 hover:text-indigo-800">+ Add</a>
|
||||
<div class="flex items-center gap-2">
|
||||
{if length annotations >= 3 then [hsx|
|
||||
<form method="POST" action={DraftRequirementAction { widgetId = widget.id }} class="inline">
|
||||
<button type="submit" class="text-xs border border-indigo-300 text-indigo-700 px-2 py-1 rounded hover:bg-indigo-50">
|
||||
Draft Requirement
|
||||
</button>
|
||||
</form>
|
||||
|] else mempty}
|
||||
<form method="POST" action={SummarizeClusterAction { widgetId = widget.id }} class="inline">
|
||||
<button type="submit" class="text-xs border border-blue-300 text-blue-700 px-2 py-1 rounded hover:bg-blue-50">
|
||||
Summarize Feedback
|
||||
</button>
|
||||
</form>
|
||||
<a href={NewAnnotationAction { widgetId = widget.id }}
|
||||
class="text-sm text-indigo-600 hover:text-indigo-800">+ Add</a>
|
||||
</div>
|
||||
</div>
|
||||
<div class="space-y-2">
|
||||
{forEach rootAnnotations (renderAnnotation childrenOf)}
|
||||
|
||||
Reference in New Issue
Block a user