inter-hub-haskell/Web/View/Widgets/New.hs

module Web.View.Widgets.New where

import Web.View.Prelude

data NewView = NewView
    { widget       :: !Widget
    , hubs         :: ![Hub]
    , adapterSpecs :: ![WidgetAdapterSpec]
    , widgetTypes  :: ![WidgetTypeRegistry]
    , policyScopes :: ![PolicyScopeRegistry]
    }

instance View NewView where
    html NewView { .. } = [hsx|
        <div class="max-w-lg">
            <h1 class="text-2xl font-semibold mb-6">Register Widget</h1>
            {renderForm widget hubs adapterSpecs widgetTypes policyScopes}
        </div>
    |]

renderForm :: Widget -> [Hub] -> [WidgetAdapterSpec] -> [WidgetTypeRegistry] -> [PolicyScopeRegistry] -> Html
renderForm widget hubs adapterSpecs widgetTypes policyScopes = formFor widget [hsx|
    {textField #name}
    {selectField #widgetType (widgetTypeOptions widgetTypes)}
    {selectField #hubId (hubOptions hubs)}
    {textField #capabilityRef}
    {textField #viewContext}
    {selectField #policyScope (policyScopeOptions policyScopes)}
    {selectField #status statusOptions}
    <div>
        <label class="ihp-form-label">Adapter Spec (optional — leave blank for native IHP widget)</label>
        <select name="adapterSpecId" class="ihp-form-field">
            <option value="">— Native IHP widget —</option>
            {forEach adapterSpecs renderAdapterOption}
        </select>
    </div>
    {submitButton}
|]

renderAdapterOption :: WidgetAdapterSpec -> Html
renderAdapterOption s = [hsx|<option value={tshow s.id}>{s.name} ({s.framework} v{s.version})</option>|]

hubOptions :: [Hub] -> [(Text, Id Hub)]
hubOptions hubs = map (\h -> (h.name, h.id)) hubs

widgetTypeOptions :: [WidgetTypeRegistry] -> [(Text, Text)]
widgetTypeOptions = map (\r -> (r.label_, r.name))

policyScopeOptions :: [PolicyScopeRegistry] -> [(Text, Text)]
policyScopeOptions = map (\r -> (r.label_, r.name))

statusOptions :: [(Text, Text)]
statusOptions =
    [ ("Active",        "active")
    , ("Deprecated",    "deprecated")
    , ("Draft",         "draft")
    ]