module Application.Helper.View where import IHP.ViewPrelude import Generated.Types import Web.Types import Web.Routes () import IHP.View.Form.Select (CanSelect(..)) -- | CanSelect instance for (Text, Text) tuples where fst is the label -- and snd is the value. Used by selectField when options are plain text pairs. instance CanSelect (Text, Text) where type SelectValue (Text, Text) = Text selectLabel = fst selectValue = snd -- | Widget Envelope — wraps any widget's rendered content with IHF governance metadata. -- -- Every interactive element that is part of the governed widget registry should -- be wrapped with this helper. It injects the stable data-* attributes that the -- client-side event capture script reads to identify the widget without coupling -- to implementation details. -- -- The envelope is validated against the v1.0 EnvelopeEmissionContract at render -- time. Missing required attributes are surfaced as an inline warning banner -- (development) rather than a hard failure, so layout is preserved in production. -- -- Required attributes (contract v1.0): -- data-widget-id — stable UUID from the widget registry -- data-view-context — logical UI location -- data-hub-id — owning hub UUID -- -- Usage: -- -- @ -- widgetEnvelope widget [hsx| -- -- |] -- @ widgetEnvelope :: Widget -> Html -> Html widgetEnvelope widget inner = let warnings = envelopeContractWarnings widget in [hsx|
{renderEnvelopeWarnings warnings} {inner}
Annotate
|] -- | Validate a Widget record against EnvelopeEmissionContract v1.0 required -- attributes. Returns a list of human-readable warning messages for any -- attribute that is missing or empty. An empty list means the widget is -- contract-compliant. envelopeContractWarnings :: Widget -> [Text] envelopeContractWarnings widget = catMaybes [ if isNothing widget.viewContext || widget.viewContext == Just "" then Just "envelope:v1.0 — data-view-context is missing (set widget.viewContext)" else Nothing -- data-widget-id and data-hub-id are always present (non-nullable fields) ] renderEnvelopeWarnings :: [Text] -> Html renderEnvelopeWarnings [] = mempty renderEnvelopeWarnings ws = [hsx|
Envelope contract warning: {forEach ws renderWarningLine}
|] renderWarningLine :: Text -> Html renderWarningLine w = [hsx|
{w}
|] -- | Status badge colour for WidgetAdapterSpec and contract status values. adapterStatusBadge :: Text -> Text adapterStatusBadge "active" = "bg-green-100 text-green-800" adapterStatusBadge "draft" = "bg-yellow-100 text-yellow-800" adapterStatusBadge "deprecated" = "bg-gray-100 text-gray-500" adapterStatusBadge "superseded" = "bg-gray-100 text-gray-400" adapterStatusBadge _ = "bg-gray-100 text-gray-600"