generated from coulomb/repo-seed
fix(WP-0014/A2): close remaining pure-param and structural compilation errors
Convert all remaining `<- paramOrNothing / param / paramOrDefault /
currentUserOrNothing` monadic binds to `let` — these functions are pure
(ImplicitParams-based) in IHP v1.5, so `<-` is a type error in an IO
do-block.
Controllers fixed:
AgentDelegations, AiGovernancePolicies, Annotations, ApiConsumers,
CollectiveProposals, DecisionRecords, DeploymentRecords,
HubCapabilityManifests, HubRoutingRules, InstitutionalKnowledge,
OutcomeCorrelations, RequirementCandidates, TypeRegistries,
WebhookSubscriptions, Widgets,
Api/V2/{Annotations,InteractionEvents,Token}
WebhookSubscriptions: remove orphaned `Right () ->` case arm that was
left inside a bare `unless` block (structural parse error).
Also carries forward all in-progress fixes from the working tree:
helpers (AgentBridge, ApiRateLimit, BottleneckDetector,
CrossHubPropagation, FrictionScore),
views (CanSelect instances, HSX lambda extraction, formFor wrappers),
env/build (envrc GHCi perms, flake.nix Tailwind + GHC resource limits,
static/app.css additional Tailwind output).
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -16,8 +16,8 @@ instance Controller AgentProposalsController where
|
||||
beforeAction = ensureIsUser
|
||||
|
||||
action AgentProposalsAction = do
|
||||
mTypeFilter <- paramOrNothing @Text "proposal_type"
|
||||
mStatusFilter <- paramOrNothing @Text "status"
|
||||
let mTypeFilter = paramOrNothing @Text "proposal_type"
|
||||
mStatusFilter = paramOrNothing @Text "status"
|
||||
proposals <- case (mTypeFilter, mStatusFilter) of
|
||||
(Nothing, Nothing) ->
|
||||
query @AgentProposal |> orderByDesc #createdAt |> fetch
|
||||
@@ -70,15 +70,15 @@ instance Controller AgentProposalsController where
|
||||
setSuccessMessage "Already reviewed"
|
||||
redirectTo ShowAgentProposalAction { agentProposalId }
|
||||
Nothing -> do
|
||||
mUser <- currentUserOrNothing
|
||||
let mUser = currentUserOrNothing
|
||||
let reviewerId = fmap (.id) mUser
|
||||
proposal
|
||||
|> set #status "accepted"
|
||||
|> updateRecord
|
||||
notes <- paramOrNothing @Text "notes"
|
||||
let notes = paramOrNothing @Text "notes"
|
||||
newRecord @AgentReviewRecord
|
||||
|> set #proposalId agentProposalId
|
||||
|> set #reviewerId (fmap (Id . unId) reviewerId)
|
||||
|> set #reviewerId (reviewerId)
|
||||
|> set #decision "accepted"
|
||||
|> set #notes notes
|
||||
|> createRecord
|
||||
@@ -86,20 +86,20 @@ instance Controller AgentProposalsController where
|
||||
when (proposal.proposalType == "requirement_draft") do
|
||||
let mParsed = decode (fromStrict (encodeUtf8 proposal.content))
|
||||
:: Maybe (HashMap Text Text)
|
||||
case mParsed of
|
||||
Just m -> do
|
||||
case (mParsed, proposal.sourceWidgetId) of
|
||||
(Just m, Just srcWid) -> 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 #sourceWidgetId srcWid
|
||||
|> set #category "friction"
|
||||
|> set #status "open"
|
||||
|> createRecord
|
||||
setSuccessMessage "Requirement candidate created from AI draft"
|
||||
Nothing ->
|
||||
setSuccessMessage "Proposal accepted (could not parse JSON for candidate)"
|
||||
_ ->
|
||||
setSuccessMessage "Proposal accepted (could not create candidate)"
|
||||
redirectTo ShowAgentProposalAction { agentProposalId }
|
||||
|
||||
action RejectProposalAction { agentProposalId } = do
|
||||
@@ -112,15 +112,15 @@ instance Controller AgentProposalsController where
|
||||
setSuccessMessage "Already reviewed"
|
||||
redirectTo ShowAgentProposalAction { agentProposalId }
|
||||
Nothing -> do
|
||||
mUser <- currentUserOrNothing
|
||||
let mUser = currentUserOrNothing
|
||||
let reviewerId = fmap (.id) mUser
|
||||
proposal
|
||||
|> set #status "rejected"
|
||||
|> updateRecord
|
||||
notes <- paramOrNothing @Text "notes"
|
||||
let notes = paramOrNothing @Text "notes"
|
||||
newRecord @AgentReviewRecord
|
||||
|> set #proposalId agentProposalId
|
||||
|> set #reviewerId (fmap (Id . unId) reviewerId)
|
||||
|> set #reviewerId (reviewerId)
|
||||
|> set #decision "rejected"
|
||||
|> set #notes notes
|
||||
|> createRecord
|
||||
|
||||
Reference in New Issue
Block a user