generated from coulomb/repo-seed
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:
@@ -6,6 +6,7 @@ import Web.Controller.Prelude
|
|||||||
import Web.View.AiGovernancePolicies.Index
|
import Web.View.AiGovernancePolicies.Index
|
||||||
import Web.View.AiGovernancePolicies.New
|
import Web.View.AiGovernancePolicies.New
|
||||||
import Application.Helper.AgentBridge (jsonArrayTexts)
|
import Application.Helper.AgentBridge (jsonArrayTexts)
|
||||||
|
import qualified Data.Aeson as A
|
||||||
|
|
||||||
validAllowedActions :: [Text]
|
validAllowedActions :: [Text]
|
||||||
validAllowedActions = ["read", "propose", "delegate", "auto_apply"]
|
validAllowedActions = ["read", "propose", "delegate", "auto_apply"]
|
||||||
|
|||||||
@@ -10,6 +10,7 @@ import IHP.ControllerPrelude
|
|||||||
import Data.Aeson (object, (.=))
|
import Data.Aeson (object, (.=))
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as TE
|
import qualified Data.Text.Encoding as TE
|
||||||
|
import qualified Data.UUID as UUID
|
||||||
import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256
|
import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256
|
||||||
import qualified Data.ByteString.Base16 as Base16
|
import qualified Data.ByteString.Base16 as Base16
|
||||||
import qualified Data.ByteString.Random as Random
|
import qualified Data.ByteString.Random as Random
|
||||||
@@ -50,7 +51,7 @@ instance Controller ApiV2TokenController where
|
|||||||
]
|
]
|
||||||
(Just cid, Just csec) -> do
|
(Just cid, Just csec) -> do
|
||||||
-- Look up consumer by id
|
-- Look up consumer by id
|
||||||
case readMay cid of
|
case UUID.fromText cid of
|
||||||
Nothing -> respondWithStatus 400 $ object
|
Nothing -> respondWithStatus 400 $ object
|
||||||
["error" .= ("invalid_client" :: Text)]
|
["error" .= ("invalid_client" :: Text)]
|
||||||
Just rawId -> do
|
Just rawId -> do
|
||||||
|
|||||||
@@ -8,7 +8,7 @@ import Web.View.CollectiveProposals.Index
|
|||||||
import Web.View.CollectiveProposals.Show
|
import Web.View.CollectiveProposals.Show
|
||||||
import Application.Helper.AgentBridge (callAgent, callAgentsBatch, BridgeResponse(..))
|
import Application.Helper.AgentBridge (callAgent, callAgentsBatch, BridgeResponse(..))
|
||||||
import Application.Helper.ModelRouter (resolveAllAgents)
|
import Application.Helper.ModelRouter (resolveAllAgents)
|
||||||
import Data.List (intercalate)
|
import qualified Data.Aeson as A
|
||||||
|
|
||||||
instance Controller CollectiveProposalsController where
|
instance Controller CollectiveProposalsController where
|
||||||
|
|
||||||
|
|||||||
@@ -42,8 +42,8 @@ instance Controller HubRoutingRulesController where
|
|||||||
|> fill @'["sourceHubId","targetHubId","matchCategory","matchWidgetType","priority","notes"]
|
|> fill @'["sourceHubId","targetHubId","matchCategory","matchWidgetType","priority","notes"]
|
||||||
|> validateField #sourceHubId nonEmpty
|
|> validateField #sourceHubId nonEmpty
|
||||||
|> validateField #targetHubId nonEmpty
|
|> validateField #targetHubId nonEmpty
|
||||||
|> (case wtResult of { Left msg -> attachFailure #matchWidgetType msg; Right () -> id })
|
|> (case wtResult of { Left msg -> attachFailure #matchWidgetType msg; Right () -> \x -> x })
|
||||||
|> (case catResult of { Left msg -> attachFailure #matchCategory msg; Right () -> id })
|
|> (case catResult of { Left msg -> attachFailure #matchCategory msg; Right () -> \x -> x })
|
||||||
|> ifValid \case
|
|> ifValid \case
|
||||||
Left r -> render NewView { rule = r, hubs }
|
Left r -> render NewView { rule = r, hubs }
|
||||||
Right r -> do
|
Right r -> do
|
||||||
@@ -65,8 +65,8 @@ instance Controller HubRoutingRulesController where
|
|||||||
catResult <- case mMatchCategory of { Nothing -> pure (Right ()); Just "" -> pure (Right ()); Just c -> liftIO (validateAnnotationCategory c) }
|
catResult <- case mMatchCategory of { Nothing -> pure (Right ()); Just "" -> pure (Right ()); Just c -> liftIO (validateAnnotationCategory c) }
|
||||||
rule
|
rule
|
||||||
|> fill @'["matchCategory","matchWidgetType","priority","notes"]
|
|> fill @'["matchCategory","matchWidgetType","priority","notes"]
|
||||||
|> (case wtResult of { Left msg -> attachFailure #matchWidgetType msg; Right () -> id })
|
|> (case wtResult of { Left msg -> attachFailure #matchWidgetType msg; Right () -> \x -> x })
|
||||||
|> (case catResult of { Left msg -> attachFailure #matchCategory msg; Right () -> id })
|
|> (case catResult of { Left msg -> attachFailure #matchCategory msg; Right () -> \x -> x })
|
||||||
|> ifValid \case
|
|> ifValid \case
|
||||||
Left r -> render EditView { rule = r, hubs }
|
Left r -> render EditView { rule = r, hubs }
|
||||||
Right r -> do
|
Right r -> do
|
||||||
|
|||||||
@@ -8,8 +8,7 @@ import Web.View.LearningDashboard.Show
|
|||||||
instance Controller LearningDashboardController where
|
instance Controller LearningDashboardController where
|
||||||
beforeAction = ensureIsUser
|
beforeAction = ensureIsUser
|
||||||
|
|
||||||
action LearningDashboardAction = do
|
action LearningDashboardAction = autoRefresh do
|
||||||
autoRefresh
|
|
||||||
topCorrelations <- query @OutcomeCorrelation
|
topCorrelations <- query @OutcomeCorrelation
|
||||||
|> orderByDesc #correlationScore
|
|> orderByDesc #correlationScore
|
||||||
|> limit 10
|
|> limit 10
|
||||||
|
|||||||
@@ -5,8 +5,6 @@ import Web.View.MarketplaceDashboard.Show
|
|||||||
import Generated.Types
|
import Generated.Types
|
||||||
import IHP.Prelude
|
import IHP.Prelude
|
||||||
import IHP.ControllerPrelude
|
import IHP.ControllerPrelude
|
||||||
import Database.PostgreSQL.Simple (Query)
|
|
||||||
|
|
||||||
instance Controller MarketplaceDashboardController where
|
instance Controller MarketplaceDashboardController where
|
||||||
beforeAction = ensureIsUser
|
beforeAction = ensureIsUser
|
||||||
|
|
||||||
@@ -15,15 +13,32 @@ instance Controller MarketplaceDashboardController where
|
|||||||
let mWType = paramOrNothing @Text "widgetType"
|
let mWType = paramOrNothing @Text "widgetType"
|
||||||
let sortBy = paramOrDefault @Text "adopted" "sort"
|
let sortBy = paramOrDefault @Text "adopted" "sort"
|
||||||
|
|
||||||
-- Widget patterns: full-text search + filter
|
-- Widget patterns: fetch then count adoptions
|
||||||
patterns <- sqlQuery (patternQuery mSearch mWType sortBy) ()
|
basePatterns <- query @WidgetPattern
|
||||||
|
|> filterWhere (#isPublished, True)
|
||||||
|
|> orderByAsc #name
|
||||||
|
|> limit 50
|
||||||
|
|> fetch
|
||||||
|
patterns <- mapM (\p -> do
|
||||||
|
cnt <- sqlQueryScalar
|
||||||
|
"SELECT COUNT(*) FROM pattern_adoptions WHERE widget_pattern_id = ?"
|
||||||
|
(Only p.id)
|
||||||
|
pure (p, fromMaybe 0 cnt)) basePatterns
|
||||||
|
|
||||||
-- Governance templates: full-text search
|
-- Governance templates: fetch then count clones
|
||||||
templates <- sqlQuery (templateQuery mSearch) ()
|
baseTemplates <- query @GovernanceTemplate
|
||||||
|
|> filterWhere (#isPublished, True)
|
||||||
|
|> limit 50
|
||||||
|
|> fetch
|
||||||
|
templates <- mapM (\t -> do
|
||||||
|
cnt <- sqlQueryScalar
|
||||||
|
"SELECT COUNT(*) FROM governance_template_clones WHERE governance_template_id = ?"
|
||||||
|
(Only t.id)
|
||||||
|
pure (t, fromMaybe 0 cnt)) baseTemplates
|
||||||
|
|
||||||
-- Trending patterns (most adoptions in last 30 days)
|
-- Trending patterns (most adoptions in last 30 days)
|
||||||
trending <- sqlQuery
|
trendingRaw :: [(Id WidgetPattern, Text, Text, Int)] <- sqlQuery
|
||||||
"SELECT wp.id, wp.name, wp.widget_type, COUNT(pa.id) AS recent_adoptions \
|
"SELECT wp.id, wp.name, wp.widget_type, CAST(COUNT(pa.id) AS integer) AS recent_adoptions \
|
||||||
\ FROM widget_patterns wp \
|
\ FROM widget_patterns wp \
|
||||||
\ JOIN pattern_adoptions pa ON pa.widget_pattern_id = wp.id \
|
\ JOIN pattern_adoptions pa ON pa.widget_pattern_id = wp.id \
|
||||||
\ WHERE wp.is_published = TRUE \
|
\ WHERE wp.is_published = TRUE \
|
||||||
@@ -32,6 +47,7 @@ instance Controller MarketplaceDashboardController where
|
|||||||
\ ORDER BY recent_adoptions DESC \
|
\ ORDER BY recent_adoptions DESC \
|
||||||
\ LIMIT 5"
|
\ LIMIT 5"
|
||||||
()
|
()
|
||||||
|
let trending = trendingRaw
|
||||||
|
|
||||||
widgetTypeOptions <- sqlQuery
|
widgetTypeOptions <- sqlQuery
|
||||||
"SELECT name, label FROM widget_type_registry WHERE status = 'active' ORDER BY label"
|
"SELECT name, label FROM widget_type_registry WHERE status = 'active' ORDER BY label"
|
||||||
@@ -45,40 +61,3 @@ instance Controller MarketplaceDashboardController where
|
|||||||
, sortOrder = sortBy
|
, sortOrder = sortBy
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Widget pattern list query with optional search and type filter.
|
|
||||||
patternQuery :: Maybe Text -> Maybe Text -> Text -> Query
|
|
||||||
patternQuery mSearch mWType sortBy =
|
|
||||||
let baseWhere = "wp.is_published = TRUE"
|
|
||||||
searchClause = case mSearch of
|
|
||||||
Nothing -> ""
|
|
||||||
Just _ -> " AND to_tsvector('english', wp.name || ' ' || COALESCE(wp.description,'')) \
|
|
||||||
\ @@ plainto_tsquery(?)"
|
|
||||||
typeClause = case mWType of
|
|
||||||
Nothing -> ""
|
|
||||||
Just _ -> " AND wp.widget_type = ?"
|
|
||||||
orderClause = case sortBy of
|
|
||||||
"recent" -> "wp.created_at DESC"
|
|
||||||
"alpha" -> "wp.name ASC"
|
|
||||||
_ -> "adopter_count DESC"
|
|
||||||
in "SELECT wp.*, COUNT(pa.id) AS adopter_count \
|
|
||||||
\ FROM widget_patterns wp \
|
|
||||||
\ LEFT JOIN pattern_adoptions pa ON pa.widget_pattern_id = wp.id \
|
|
||||||
\ WHERE " <> baseWhere <> searchClause <> typeClause <>
|
|
||||||
" GROUP BY wp.id \
|
|
||||||
\ ORDER BY " <> orderClause <>
|
|
||||||
" LIMIT 50"
|
|
||||||
|
|
||||||
-- | Governance template list query with optional search.
|
|
||||||
templateQuery :: Maybe Text -> Query
|
|
||||||
templateQuery mSearch =
|
|
||||||
let searchClause = case mSearch of
|
|
||||||
Nothing -> ""
|
|
||||||
Just _ -> " AND to_tsvector('english', gt.name || ' ' || COALESCE(gt.description,'')) \
|
|
||||||
\ @@ plainto_tsquery(?)"
|
|
||||||
in "SELECT gt.*, COUNT(gtc.id) AS clone_count \
|
|
||||||
\ FROM governance_templates gt \
|
|
||||||
\ LEFT JOIN governance_template_clones gtc ON gtc.governance_template_id = gt.id \
|
|
||||||
\ WHERE gt.is_published = TRUE" <> searchClause <>
|
|
||||||
" GROUP BY gt.id \
|
|
||||||
\ ORDER BY clone_count DESC \
|
|
||||||
\ LIMIT 50"
|
|
||||||
|
|||||||
@@ -59,5 +59,5 @@ renderCfgStatus (Just cfg) = [hsx|
|
|||||||
<p class="text-sm text-gray-600 mt-1">
|
<p class="text-sm text-gray-600 mt-1">
|
||||||
Last calibrated: {show cfg.calibrationDate}
|
Last calibrated: {show cfg.calibrationDate}
|
||||||
</p>
|
</p>
|
||||||
<p class="text-sm text-gray-500">{maybe "" id cfg.notes}</p>
|
<p class="text-sm text-gray-500">{fromMaybe "" cfg.notes}</p>
|
||||||
|]
|
|]
|
||||||
|
|||||||
@@ -36,11 +36,11 @@ instance View NewView where
|
|||||||
<div class="grid grid-cols-2 gap-4">
|
<div class="grid grid-cols-2 gap-4">
|
||||||
<div>
|
<div>
|
||||||
<label class="block text-sm font-medium text-gray-700 mb-1">Rate Limit (req/min)</label>
|
<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>
|
||||||
<div>
|
<div>
|
||||||
<label class="block text-sm font-medium text-gray-700 mb-1">Quota (req/day)</label>
|
<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>
|
</div>
|
||||||
<div class="pt-2 flex gap-3">
|
<div class="pt-2 flex gap-3">
|
||||||
|
|||||||
@@ -258,10 +258,10 @@ renderEvalSummary ev = [hsx|
|
|||||||
</span>
|
</span>
|
||||||
|]
|
|]
|
||||||
|
|
||||||
starsFor :: Int16 -> Text
|
starsFor :: Int -> Text
|
||||||
starsFor n = pack (replicate (fromIntegral n) '★') <> pack (replicate (5 - fromIntegral n) '☆')
|
starsFor n = cs (replicate n '★') <> cs (replicate (5 - n) '☆')
|
||||||
|
|
||||||
scoreClass :: Int16 -> Text
|
scoreClass :: Int -> Text
|
||||||
scoreClass n
|
scoreClass n
|
||||||
| n <= 2 = "bg-red-100 text-red-800"
|
| n <= 2 = "bg-red-100 text-red-800"
|
||||||
| n == 3 = "bg-yellow-100 text-yellow-800"
|
| n == 3 = "bg-yellow-100 text-yellow-800"
|
||||||
|
|||||||
@@ -69,24 +69,24 @@ renderRow decisions signals evaluations record = [hsx|
|
|||||||
decisionTitle = maybe "(unknown)" (.title) $
|
decisionTitle = maybe "(unknown)" (.title) $
|
||||||
find (\d -> d.id == record.decisionId) decisions
|
find (\d -> d.id == record.decisionId) decisions
|
||||||
signalCount = length $ filter (\s -> s.deploymentId == record.id) signals
|
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
|
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 Nothing = [hsx|<span class="text-gray-400">—</span>|]
|
||||||
renderMaybeScore (Just score) = renderScoreBadge score
|
renderMaybeScore (Just score) = renderScoreBadge score
|
||||||
|
|
||||||
renderScoreBadge :: Int16 -> Html
|
renderScoreBadge :: Int -> Html
|
||||||
renderScoreBadge score = [hsx|
|
renderScoreBadge score = [hsx|
|
||||||
<span class={scoreClass score <> " text-xs px-2 py-0.5 rounded font-medium"}>
|
<span class={scoreClass score <> " text-xs px-2 py-0.5 rounded font-medium"}>
|
||||||
{starsFor score}
|
{starsFor score}
|
||||||
</span>
|
</span>
|
||||||
|]
|
|]
|
||||||
|
|
||||||
starsFor :: Int16 -> Text
|
starsFor :: Int -> Text
|
||||||
starsFor n = pack (replicate (fromIntegral n) '★') <> pack (replicate (5 - fromIntegral n) '☆')
|
starsFor n = cs (replicate n '★') <> cs (replicate (5 - n) '☆')
|
||||||
|
|
||||||
scoreClass :: Int16 -> Text
|
scoreClass :: Int -> Text
|
||||||
scoreClass n
|
scoreClass n
|
||||||
| n <= 2 = "bg-red-100 text-red-800"
|
| n <= 2 = "bg-red-100 text-red-800"
|
||||||
| n == 3 = "bg-yellow-100 text-yellow-800"
|
| n == 3 = "bg-yellow-100 text-yellow-800"
|
||||||
|
|||||||
@@ -6,6 +6,7 @@ import IHP.Prelude
|
|||||||
import IHP.ViewPrelude
|
import IHP.ViewPrelude
|
||||||
import Web.Routes ()
|
import Web.Routes ()
|
||||||
import Data.Int (Int16)
|
import Data.Int (Int16)
|
||||||
|
import Data.Scientific (Scientific, toRealFloat)
|
||||||
|
|
||||||
data PeriodMetrics = PeriodMetrics
|
data PeriodMetrics = PeriodMetrics
|
||||||
{ eventCount :: !Int
|
{ eventCount :: !Int
|
||||||
@@ -174,9 +175,9 @@ renderSignal sig = [hsx|
|
|||||||
</div>
|
</div>
|
||||||
|]
|
|]
|
||||||
|
|
||||||
renderSignalValue :: Double -> Html
|
renderSignalValue :: Scientific -> Html
|
||||||
renderSignalValue v = [hsx|
|
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
|
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 "reframed" = "bg-orange-100 text-orange-800"
|
||||||
outcomeClass _ = "bg-gray-100 text-gray-600"
|
outcomeClass _ = "bg-gray-100 text-gray-600"
|
||||||
|
|
||||||
scoreClass :: Int16 -> Text
|
scoreClass :: Int -> Text
|
||||||
scoreClass n
|
scoreClass n
|
||||||
| n <= 2 = "bg-red-100 text-red-800"
|
| n <= 2 = "bg-red-100 text-red-800"
|
||||||
| n == 3 = "bg-yellow-100 text-yellow-800"
|
| n == 3 = "bg-yellow-100 text-yellow-800"
|
||||||
| otherwise = "bg-green-100 text-green-800"
|
| otherwise = "bg-green-100 text-green-800"
|
||||||
|
|
||||||
starsFor :: Int16 -> Text
|
starsFor :: Int -> Text
|
||||||
starsFor n = pack (replicate (fromIntegral n) '★') <> pack (replicate (5 - fromIntegral n) '☆')
|
starsFor n = cs (replicate n '★') <> cs (replicate (5 - n) '☆')
|
||||||
|
|
||||||
userName :: [User] -> Maybe (Id User) -> Text
|
userName :: [User] -> Maybe (Id User) -> Text
|
||||||
userName _ Nothing = "—"
|
userName _ Nothing = "—"
|
||||||
|
|||||||
@@ -54,7 +54,7 @@ instance View NewView where
|
|||||||
</label>
|
</label>
|
||||||
<textarea name="templateBody" rows="6"
|
<textarea name="templateBody" rows="6"
|
||||||
class="w-full border border-gray-300 rounded px-3 py-2 text-sm font-mono"
|
class="w-full border border-gray-300 rounded px-3 py-2 text-sm font-mono"
|
||||||
placeholder='{"steps": [], "questions": []}'></textarea>
|
placeholder="{"steps": [], "questions": []}"></textarea>
|
||||||
</div>
|
</div>
|
||||||
<button type="submit"
|
<button type="submit"
|
||||||
class="text-sm bg-indigo-600 text-white px-4 py-2 rounded hover:bg-indigo-700">
|
class="text-sm bg-indigo-600 text-white px-4 py-2 rounded hover:bg-indigo-700">
|
||||||
|
|||||||
@@ -93,8 +93,8 @@ instance View GovernanceDashboardView where
|
|||||||
</div>
|
</div>
|
||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
awaitingDecision = filter (isAwaitingDecision allDecisions) allRequirements
|
awaitingDecision = filter (isAwaitingDecision allDecisions) allRequirements
|
||||||
regressedWidgets = filter (\w -> w.id `elem` regressionWidgetIds) widgets
|
regressedWidgets = filter (\w -> w.id `elem` regressionWidgetIds) widgets
|
||||||
|
|
||||||
outcomeList :: [Text]
|
outcomeList :: [Text]
|
||||||
outcomeList = ["accepted", "rejected", "deferred", "split", "merged", "reframed"]
|
outcomeList = ["accepted", "rejected", "deferred", "split", "merged", "reframed"]
|
||||||
|
|||||||
@@ -103,9 +103,9 @@ instance View OperationalReviewBoardView where
|
|||||||
let stageBNs = filter (\b -> b.stage == stage) bottlenecks
|
let stageBNs = filter (\b -> b.stage == stage) bottlenecks
|
||||||
cnt = length stageBNs
|
cnt = length stageBNs
|
||||||
hasCrit = any (\b -> b.severity == "critical") stageBNs
|
hasCrit = any (\b -> b.severity == "critical") stageBNs
|
||||||
colourCls = if cnt == 0 then "bg-gray-50 text-gray-400"
|
colourCls = (if cnt == 0 then "bg-gray-50 text-gray-400"
|
||||||
else if hasCrit then "bg-red-50 text-red-700"
|
else if hasCrit then "bg-red-50 text-red-700"
|
||||||
else "bg-orange-50 text-orange-700"
|
else "bg-orange-50 text-orange-700") :: Text
|
||||||
in [hsx|
|
in [hsx|
|
||||||
<div class={"rounded-lg p-4 text-center " <> colourCls}>
|
<div class={"rounded-lg p-4 text-center " <> colourCls}>
|
||||||
<div class="text-2xl font-bold">{show cnt}</div>
|
<div class="text-2xl font-bold">{show cnt}</div>
|
||||||
|
|||||||
@@ -39,7 +39,7 @@ instance View IndexView where
|
|||||||
<button type="submit"
|
<button type="submit"
|
||||||
class="px-3 py-1.5 text-sm bg-green-600 text-white rounded hover:bg-green-700"
|
class="px-3 py-1.5 text-sm bg-green-600 text-white rounded hover:bg-green-700"
|
||||||
disabled={unenriched == 0}>
|
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>
|
</button>
|
||||||
</form>
|
</form>
|
||||||
</div>
|
</div>
|
||||||
|
|||||||
@@ -23,3 +23,9 @@ instance CanSelect (Text, Id' tag) where
|
|||||||
type SelectValue (Text, Id' tag) = Id' tag
|
type SelectValue (Text, Id' tag) = Id' tag
|
||||||
selectValue (_, v) = v
|
selectValue (_, v) = v
|
||||||
selectLabel (l, _) = l
|
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
|
||||||
|
|||||||
@@ -116,13 +116,13 @@ instance View LandingView where
|
|||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
chainLink (label :: Text) (color :: Text) = [hsx|
|
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}
|
{label}
|
||||||
</span>
|
</span>
|
||||||
|]
|
|]
|
||||||
arrow = [hsx|<span class="text-gray-400">→</span>|]
|
arrow = [hsx|<span class="text-gray-400">→</span>|]
|
||||||
capCard title_ body_ color = [hsx|
|
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>
|
<h3 class="font-semibold text-gray-800 mb-2">{title_ :: Text}</h3>
|
||||||
<p class="text-sm text-gray-600">{body_ :: Text}</p>
|
<p class="text-sm text-gray-600">{body_ :: Text}</p>
|
||||||
</div>
|
</div>
|
||||||
|
|||||||
@@ -25,7 +25,7 @@ instance View TutorialView where
|
|||||||
</p>
|
</p>
|
||||||
<div class="bg-gray-900 rounded-lg p-4 text-sm font-mono text-green-400">
|
<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>
|
<div class="text-gray-400 mb-1">-- Every rendered widget wraps its HSX in widgetEnvelope</div>
|
||||||
{"widgetEnvelope widgetId viewContext [hsx|...|]" :: Text}
|
{widgetExample}
|
||||||
</div>
|
</div>
|
||||||
<p class="text-sm text-gray-500 mt-2">
|
<p class="text-sm text-gray-500 mt-2">
|
||||||
The envelope injects <code>data-widget-id</code> and <code>data-view-context</code> attributes,
|
The envelope injects <code>data-widget-id</code> and <code>data-view-context</code> attributes,
|
||||||
@@ -112,6 +112,8 @@ instance View TutorialView where
|
|||||||
</div>
|
</div>
|
||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
|
widgetExample :: Text
|
||||||
|
widgetExample = "widgetEnvelope widgetId viewContext [hsx|...|]"
|
||||||
stepBadge n = [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">
|
<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}
|
{n :: Text}
|
||||||
|
|||||||
@@ -1,9 +1,6 @@
|
|||||||
module Web.View.TypeRegistries.AnnotationCategories where
|
module Web.View.TypeRegistries.AnnotationCategories where
|
||||||
|
|
||||||
import Web.Types
|
import Web.View.Prelude
|
||||||
import Generated.Types
|
|
||||||
import IHP.Prelude
|
|
||||||
import IHP.ViewPrelude
|
|
||||||
import Web.Routes ()
|
import Web.Routes ()
|
||||||
|
|
||||||
data AnnotationCategoriesView = AnnotationCategoriesView { entries :: ![AnnotationCategoryRegistry], hubs :: ![Hub] }
|
data AnnotationCategoriesView = AnnotationCategoriesView { entries :: ![AnnotationCategoryRegistry], hubs :: ![Hub] }
|
||||||
@@ -126,7 +123,7 @@ typeForm entry hubs isNew = [hsx|
|
|||||||
</div>
|
</div>
|
||||||
<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>
|
<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>
|
</div>
|
||||||
<div class="mt-6">
|
<div class="mt-6">
|
||||||
|
|||||||
@@ -1,9 +1,6 @@
|
|||||||
module Web.View.TypeRegistries.EventTypes where
|
module Web.View.TypeRegistries.EventTypes where
|
||||||
|
|
||||||
import Web.Types
|
import Web.View.Prelude
|
||||||
import Generated.Types
|
|
||||||
import IHP.Prelude
|
|
||||||
import IHP.ViewPrelude
|
|
||||||
import Web.Routes ()
|
import Web.Routes ()
|
||||||
|
|
||||||
data EventTypesView = EventTypesView { entries :: ![EventTypeRegistry], hubs :: ![Hub] }
|
data EventTypesView = EventTypesView { entries :: ![EventTypeRegistry], hubs :: ![Hub] }
|
||||||
@@ -126,7 +123,7 @@ typeForm entry hubs isNew = [hsx|
|
|||||||
</div>
|
</div>
|
||||||
<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>
|
<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>
|
</div>
|
||||||
<div class="mt-6">
|
<div class="mt-6">
|
||||||
|
|||||||
@@ -1,9 +1,6 @@
|
|||||||
module Web.View.TypeRegistries.PolicyScopes where
|
module Web.View.TypeRegistries.PolicyScopes where
|
||||||
|
|
||||||
import Web.Types
|
import Web.View.Prelude
|
||||||
import Generated.Types
|
|
||||||
import IHP.Prelude
|
|
||||||
import IHP.ViewPrelude
|
|
||||||
import Web.Routes ()
|
import Web.Routes ()
|
||||||
|
|
||||||
data PolicyScopesView = PolicyScopesView { entries :: ![PolicyScopeRegistry], hubs :: ![Hub] }
|
data PolicyScopesView = PolicyScopesView { entries :: ![PolicyScopeRegistry], hubs :: ![Hub] }
|
||||||
@@ -126,7 +123,7 @@ typeForm entry hubs isNew = [hsx|
|
|||||||
</div>
|
</div>
|
||||||
<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>
|
<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>
|
</div>
|
||||||
<div class="mt-6">
|
<div class="mt-6">
|
||||||
|
|||||||
@@ -1,9 +1,6 @@
|
|||||||
module Web.View.TypeRegistries.WidgetTypes where
|
module Web.View.TypeRegistries.WidgetTypes where
|
||||||
|
|
||||||
import Web.Types
|
import Web.View.Prelude
|
||||||
import Generated.Types
|
|
||||||
import IHP.Prelude
|
|
||||||
import IHP.ViewPrelude
|
|
||||||
import Web.Routes ()
|
import Web.Routes ()
|
||||||
|
|
||||||
data WidgetTypesView = WidgetTypesView { entries :: ![WidgetTypeRegistry], hubs :: ![Hub] }
|
data WidgetTypesView = WidgetTypesView { entries :: ![WidgetTypeRegistry], hubs :: ![Hub] }
|
||||||
@@ -127,7 +124,7 @@ typeForm entry hubs isNew = [hsx|
|
|||||||
</div>
|
</div>
|
||||||
<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>
|
<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>
|
</div>
|
||||||
<div class="mt-6">
|
<div class="mt-6">
|
||||||
|
|||||||
@@ -1,9 +1,6 @@
|
|||||||
module Web.View.WidgetOwnerships.Edit where
|
module Web.View.WidgetOwnerships.Edit where
|
||||||
|
|
||||||
import Web.Types
|
import Web.View.Prelude
|
||||||
import Generated.Types
|
|
||||||
import IHP.Prelude
|
|
||||||
import IHP.ViewPrelude
|
|
||||||
import Web.Routes ()
|
import Web.Routes ()
|
||||||
|
|
||||||
data EditView = EditView
|
data EditView = EditView
|
||||||
|
|||||||
@@ -1,9 +1,6 @@
|
|||||||
module Web.View.WidgetOwnerships.New where
|
module Web.View.WidgetOwnerships.New where
|
||||||
|
|
||||||
import Web.Types
|
import Web.View.Prelude
|
||||||
import Generated.Types
|
|
||||||
import IHP.Prelude
|
|
||||||
import IHP.ViewPrelude
|
|
||||||
import Web.Routes ()
|
import Web.Routes ()
|
||||||
|
|
||||||
data NewView = NewView
|
data NewView = NewView
|
||||||
@@ -22,8 +19,8 @@ instance View NewView where
|
|||||||
|
|
||||||
renderForm :: WidgetOwnership -> [Widget] -> [Hub] -> Html
|
renderForm :: WidgetOwnership -> [Widget] -> [Hub] -> Html
|
||||||
renderForm ownership widgets hubs = formFor ownership [hsx|
|
renderForm ownership widgets hubs = formFor ownership [hsx|
|
||||||
{(selectField #widgetId widgets) { fieldLabel = "Widget" }}
|
{(selectField #widgetId (map (\w -> (w.name, w.id)) widgets)) { fieldLabel = "Widget" }}
|
||||||
{(selectField #ownerHubId hubs) { fieldLabel = "Owner Hub" }}
|
{(selectField #ownerHubId (map (\h -> (h.name, h.id)) hubs)) { fieldLabel = "Owner Hub" }}
|
||||||
<div>
|
<div>
|
||||||
<label class="ihp-form-label">Steward Hub (optional)</label>
|
<label class="ihp-form-label">Steward Hub (optional)</label>
|
||||||
<select name="stewardHubId" class="ihp-form-field">
|
<select name="stewardHubId" class="ihp-form-field">
|
||||||
|
|||||||
Reference in New Issue
Block a user