fix(WP-0017/E5): Layer 3 error fixes — round 3 (24 files)

Int16→Int in score/stars functions; uuid-based readMay→UUID.fromText;
autoRefresh do-notation fix; id→\x->x ambiguity in HubRoutingRules;
MarketplaceDashboard replaced raw SQL with IHP query builder; optional
hub selector in TypeRegistry views via CanSelect (Text, Maybe Id) instance
added to Web.View.Prelude; import consolidations to Web.View.Prelude.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-04-12 13:11:32 +00:00
parent 3737845e02
commit 2c22766cd6
24 changed files with 81 additions and 110 deletions

View File

@@ -59,5 +59,5 @@ renderCfgStatus (Just cfg) = [hsx|
<p class="text-sm text-gray-600 mt-1">
Last calibrated: {show cfg.calibrationDate}
</p>
<p class="text-sm text-gray-500">{maybe "" id cfg.notes}</p>
<p class="text-sm text-gray-500">{fromMaybe "" cfg.notes}</p>
|]

View File

@@ -36,11 +36,11 @@ instance View NewView where
<div class="grid grid-cols-2 gap-4">
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Rate Limit (req/min)</label>
<input type="number" name="rateLimitPerMinute" value={maybe "" show consumer.rateLimitPerMinute} class="border rounded px-3 py-2 text-sm w-full" />
<input type="number" name="rateLimitPerMinute" value={tshow consumer.rateLimitPerMinute} class="border rounded px-3 py-2 text-sm w-full" />
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Quota (req/day)</label>
<input type="number" name="quotaPerDay" value={maybe "" show consumer.quotaPerDay} class="border rounded px-3 py-2 text-sm w-full" />
<input type="number" name="quotaPerDay" value={tshow consumer.quotaPerDay} class="border rounded px-3 py-2 text-sm w-full" />
</div>
</div>
<div class="pt-2 flex gap-3">

View File

@@ -258,10 +258,10 @@ renderEvalSummary ev = [hsx|
</span>
|]
starsFor :: Int16 -> Text
starsFor n = pack (replicate (fromIntegral n) '★') <> pack (replicate (5 - fromIntegral n) '☆')
starsFor :: Int -> Text
starsFor n = cs (replicate n '★') <> cs (replicate (5 - n) '☆')
scoreClass :: Int16 -> Text
scoreClass :: Int -> Text
scoreClass n
| n <= 2 = "bg-red-100 text-red-800"
| n == 3 = "bg-yellow-100 text-yellow-800"

View File

@@ -69,24 +69,24 @@ renderRow decisions signals evaluations record = [hsx|
decisionTitle = maybe "(unknown)" (.title) $
find (\d -> d.id == record.decisionId) decisions
signalCount = length $ filter (\s -> s.deploymentId == record.id) signals
mScore :: Maybe Int16
mScore :: Maybe Int
mScore = fmap (.score) $ find (\e -> e.deploymentId == record.id) evaluations
renderMaybeScore :: Maybe Int16 -> Html
renderMaybeScore :: Maybe Int -> Html
renderMaybeScore Nothing = [hsx|<span class="text-gray-400"></span>|]
renderMaybeScore (Just score) = renderScoreBadge score
renderScoreBadge :: Int16 -> Html
renderScoreBadge :: Int -> Html
renderScoreBadge score = [hsx|
<span class={scoreClass score <> " text-xs px-2 py-0.5 rounded font-medium"}>
{starsFor score}
</span>
|]
starsFor :: Int16 -> Text
starsFor n = pack (replicate (fromIntegral n) '★') <> pack (replicate (5 - fromIntegral n) '☆')
starsFor :: Int -> Text
starsFor n = cs (replicate n '★') <> cs (replicate (5 - n) '☆')
scoreClass :: Int16 -> Text
scoreClass :: Int -> Text
scoreClass n
| n <= 2 = "bg-red-100 text-red-800"
| n == 3 = "bg-yellow-100 text-yellow-800"

View File

@@ -6,6 +6,7 @@ import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Int (Int16)
import Data.Scientific (Scientific, toRealFloat)
data PeriodMetrics = PeriodMetrics
{ eventCount :: !Int
@@ -174,9 +175,9 @@ renderSignal sig = [hsx|
</div>
|]
renderSignalValue :: Double -> Html
renderSignalValue :: Scientific -> Html
renderSignalValue v = [hsx|
<span class="text-sm text-gray-700 font-mono">{show v}</span>
<span class="text-sm text-gray-700 font-mono">{show (toRealFloat v :: Double)}</span>
|]
renderNoEvaluationForm :: Id DeploymentRecord -> Html
@@ -321,14 +322,14 @@ outcomeClass "merged" = "bg-indigo-100 text-indigo-800"
outcomeClass "reframed" = "bg-orange-100 text-orange-800"
outcomeClass _ = "bg-gray-100 text-gray-600"
scoreClass :: Int16 -> Text
scoreClass :: Int -> Text
scoreClass n
| n <= 2 = "bg-red-100 text-red-800"
| n == 3 = "bg-yellow-100 text-yellow-800"
| otherwise = "bg-green-100 text-green-800"
starsFor :: Int16 -> Text
starsFor n = pack (replicate (fromIntegral n) '★') <> pack (replicate (5 - fromIntegral n) '☆')
starsFor :: Int -> Text
starsFor n = cs (replicate n '★') <> cs (replicate (5 - n) '☆')
userName :: [User] -> Maybe (Id User) -> Text
userName _ Nothing = ""

View File

@@ -54,7 +54,7 @@ instance View NewView where
</label>
<textarea name="templateBody" rows="6"
class="w-full border border-gray-300 rounded px-3 py-2 text-sm font-mono"
placeholder='{"steps": [], "questions": []}'></textarea>
placeholder="{&quot;steps&quot;: [], &quot;questions&quot;: []}"></textarea>
</div>
<button type="submit"
class="text-sm bg-indigo-600 text-white px-4 py-2 rounded hover:bg-indigo-700">

View File

@@ -93,8 +93,8 @@ instance View GovernanceDashboardView where
</div>
|]
where
awaitingDecision = filter (isAwaitingDecision allDecisions) allRequirements
regressedWidgets = filter (\w -> w.id `elem` regressionWidgetIds) widgets
awaitingDecision = filter (isAwaitingDecision allDecisions) allRequirements
regressedWidgets = filter (\w -> w.id `elem` regressionWidgetIds) widgets
outcomeList :: [Text]
outcomeList = ["accepted", "rejected", "deferred", "split", "merged", "reframed"]

View File

@@ -103,9 +103,9 @@ instance View OperationalReviewBoardView where
let stageBNs = filter (\b -> b.stage == stage) bottlenecks
cnt = length stageBNs
hasCrit = any (\b -> b.severity == "critical") stageBNs
colourCls = if cnt == 0 then "bg-gray-50 text-gray-400"
else if hasCrit then "bg-red-50 text-red-700"
else "bg-orange-50 text-orange-700"
colourCls = (if cnt == 0 then "bg-gray-50 text-gray-400"
else if hasCrit then "bg-red-50 text-red-700"
else "bg-orange-50 text-orange-700") :: Text
in [hsx|
<div class={"rounded-lg p-4 text-center " <> colourCls}>
<div class="text-2xl font-bold">{show cnt}</div>

View File

@@ -39,7 +39,7 @@ instance View IndexView where
<button type="submit"
class="px-3 py-1.5 text-sm bg-green-600 text-white rounded hover:bg-green-700"
disabled={unenriched == 0}>
{if unenriched == 0 then "Up to date" else "Enrich Now"}
{(if unenriched == 0 then "Up to date" else "Enrich Now") :: Text}
</button>
</form>
</div>

View File

@@ -23,3 +23,9 @@ instance CanSelect (Text, Id' tag) where
type SelectValue (Text, Id' tag) = Id' tag
selectValue (_, v) = v
selectLabel (l, _) = l
-- | Allow [(Text, Maybe (Id' tag))] option lists (e.g. optional hub selectors).
instance CanSelect (Text, Maybe (Id' tag)) where
type SelectValue (Text, Maybe (Id' tag)) = Maybe (Id' tag)
selectValue (_, v) = v
selectLabel (l, _) = l

View File

@@ -116,13 +116,13 @@ instance View LandingView where
|]
where
chainLink (label :: Text) (color :: Text) = [hsx|
<span class={"inline-block px-2 py-1 rounded text-xs bg-" <> color <> "-100 text-" <> color <> "-800 font-mono"}>
<span class={("inline-block px-2 py-1 rounded text-xs bg-" <> color <> "-100 text-" <> color <> "-800 font-mono") :: Text}>
{label}
</span>
|]
arrow = [hsx|<span class="text-gray-400"></span>|]
capCard title_ body_ color = [hsx|
<div class={"bg-white rounded-lg border border-gray-200 p-5 border-l-4 border-l-" <> color <> "-500"}>
<div class={("bg-white rounded-lg border border-gray-200 p-5 border-l-4 border-l-" <> color <> "-500") :: Text}>
<h3 class="font-semibold text-gray-800 mb-2">{title_ :: Text}</h3>
<p class="text-sm text-gray-600">{body_ :: Text}</p>
</div>

View File

@@ -25,7 +25,7 @@ instance View TutorialView where
</p>
<div class="bg-gray-900 rounded-lg p-4 text-sm font-mono text-green-400">
<div class="text-gray-400 mb-1">-- Every rendered widget wraps its HSX in widgetEnvelope</div>
{"widgetEnvelope widgetId viewContext [hsx|...|]" :: Text}
{widgetExample}
</div>
<p class="text-sm text-gray-500 mt-2">
The envelope injects <code>data-widget-id</code> and <code>data-view-context</code> attributes,
@@ -112,6 +112,8 @@ instance View TutorialView where
</div>
|]
where
widgetExample :: Text
widgetExample = "widgetEnvelope widgetId viewContext [hsx|...|]"
stepBadge n = [hsx|
<span class="inline-flex items-center justify-center w-7 h-7 rounded-full bg-indigo-600 text-white text-sm font-bold mr-2">
{n :: Text}

View File

@@ -1,9 +1,6 @@
module Web.View.TypeRegistries.AnnotationCategories where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.View.Prelude
import Web.Routes ()
data AnnotationCategoriesView = AnnotationCategoriesView { entries :: ![AnnotationCategoryRegistry], hubs :: ![Hub] }
@@ -126,7 +123,7 @@ typeForm entry hubs isNew = [hsx|
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Owner Hub <span class="text-gray-400 text-xs">(blank = framework-level)</span></label>
{selectField #ownerHubId hubs}
{selectField #ownerHubId (("" :: Text, Nothing) : map (\h -> (h.name, Just h.id)) hubs)}
</div>
</div>
<div class="mt-6">

View File

@@ -1,9 +1,6 @@
module Web.View.TypeRegistries.EventTypes where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.View.Prelude
import Web.Routes ()
data EventTypesView = EventTypesView { entries :: ![EventTypeRegistry], hubs :: ![Hub] }
@@ -126,7 +123,7 @@ typeForm entry hubs isNew = [hsx|
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Owner Hub <span class="text-gray-400 text-xs">(blank = framework-level)</span></label>
{selectField #ownerHubId hubs}
{selectField #ownerHubId (("" :: Text, Nothing) : map (\h -> (h.name, Just h.id)) hubs)}
</div>
</div>
<div class="mt-6">

View File

@@ -1,9 +1,6 @@
module Web.View.TypeRegistries.PolicyScopes where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.View.Prelude
import Web.Routes ()
data PolicyScopesView = PolicyScopesView { entries :: ![PolicyScopeRegistry], hubs :: ![Hub] }
@@ -126,7 +123,7 @@ typeForm entry hubs isNew = [hsx|
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Owner Hub <span class="text-gray-400 text-xs">(blank = framework-level)</span></label>
{selectField #ownerHubId hubs}
{selectField #ownerHubId (("" :: Text, Nothing) : map (\h -> (h.name, Just h.id)) hubs)}
</div>
</div>
<div class="mt-6">

View File

@@ -1,9 +1,6 @@
module Web.View.TypeRegistries.WidgetTypes where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.View.Prelude
import Web.Routes ()
data WidgetTypesView = WidgetTypesView { entries :: ![WidgetTypeRegistry], hubs :: ![Hub] }
@@ -127,7 +124,7 @@ typeForm entry hubs isNew = [hsx|
</div>
<div>
<label class="block text-sm font-medium text-gray-700 mb-1">Owner Hub <span class="text-gray-400 text-xs">(leave blank for framework-level)</span></label>
{selectField #ownerHubId hubs}
{selectField #ownerHubId (("" :: Text, Nothing) : map (\h -> (h.name, Just h.id)) hubs)}
</div>
</div>
<div class="mt-6">

View File

@@ -1,9 +1,6 @@
module Web.View.WidgetOwnerships.Edit where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.View.Prelude
import Web.Routes ()
data EditView = EditView

View File

@@ -1,9 +1,6 @@
module Web.View.WidgetOwnerships.New where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.View.Prelude
import Web.Routes ()
data NewView = NewView
@@ -22,8 +19,8 @@ instance View NewView where
renderForm :: WidgetOwnership -> [Widget] -> [Hub] -> Html
renderForm ownership widgets hubs = formFor ownership [hsx|
{(selectField #widgetId widgets) { fieldLabel = "Widget" }}
{(selectField #ownerHubId hubs) { fieldLabel = "Owner Hub" }}
{(selectField #widgetId (map (\w -> (w.name, w.id)) widgets)) { fieldLabel = "Widget" }}
{(selectField #ownerHubId (map (\h -> (h.name, h.id)) hubs)) { fieldLabel = "Owner Hub" }}
<div>
<label class="ihp-form-label">Steward Hub (optional)</label>
<select name="stewardHubId" class="ihp-form-field">