Files
inter-hub/Web/View/HubRegistry/Index.hs
tegwick 5d5e810886
Some checks failed
Build and Deploy / build-push-deploy (push) Has been cancelled
feat: add vsm hub metadata
2026-05-19 02:16:39 +02:00

100 lines
3.9 KiB
Haskell

module Web.View.HubRegistry.Index where
import Web.Types
import Web.Types (HubRegistryRow(..), GaafStatus(..), gaafStatus)
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Aeson (Value(..))
import qualified Data.Vector as V
data IndexView = IndexView
{ registryRows :: ![HubRegistryRow]
}
instance View IndexView where
html IndexView { .. } = [hsx|
<div class="flex items-center justify-between mb-6">
<div>
<h1 class="text-2xl font-semibold">Hub Registry</h1>
<p class="text-sm text-gray-500 mt-1">
All registered hubs with capability manifests and health status.
</p>
</div>
<a href={MarketplaceDashboardAction}
class="text-sm border border-indigo-300 text-indigo-700 px-3 py-1.5 rounded hover:bg-indigo-50">
Marketplace
</a>
</div>
<div class="space-y-3">
{forEach registryRows renderRow}
{if null registryRows then noHubsMsg else mempty}
</div>
|]
noHubsMsg :: Html
noHubsMsg = [hsx|<p class="text-sm text-gray-400">No hubs registered yet.</p>|]
renderRow :: HubRegistryRow -> Html
renderRow row@HubRegistryRow { hub, mManifest, mLatestSnapshot } =
let gs = gaafStatus mManifest
wCount = maybe 0 (jsonArrayLen . (.declaredWidgetTypes)) mManifest
eCount = maybe 0 (jsonArrayLen . (.declaredEventTypes)) mManifest
cCount = maybe 0 (jsonArrayLen . (.declaredAnnotationCategories)) mManifest
score = fmap (.healthScore) mLatestSnapshot
in [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-4 hover:border-indigo-200">
<div class="flex items-center justify-between">
<div class="flex items-center gap-3">
<a href={ShowHubRegistryAction (hub.id)}
class="font-medium text-indigo-700 hover:underline">
{hub.name}
</a>
<span class="text-xs text-gray-400 font-mono">{hub.hubKind}</span>
{classificationBadge hub}
{gaafBadge gs}
</div>
<div class="flex items-center gap-4 text-xs text-gray-500">
{maybe mempty healthScoreBadge score}
<span>{tshow wCount} widget types</span>
<span>{tshow eCount} event types</span>
<span>{tshow cCount} categories</span>
</div>
</div>
<p class="text-xs text-gray-400 mt-1">{hub.domain}</p>
</div>
|]
gaafBadge :: GaafStatus -> Html
gaafBadge GaafCompliant =
[hsx|<span class="px-2 py-0.5 rounded text-xs bg-green-100 text-green-800">GAAF compliant</span>|]
gaafBadge GaafDraftOnly =
[hsx|<span class="px-2 py-0.5 rounded text-xs bg-amber-100 text-amber-800">draft manifest</span>|]
gaafBadge GaafNoManifest =
[hsx|<span class="px-2 py-0.5 rounded text-xs bg-red-100 text-red-700">no manifest</span>|]
classificationBadge :: Hub -> Html
classificationBadge hub =
case (hub.hubFamily, hub.vsmFunction, hub.vsmSystem) of
(Just "vsm", Just functionName, Just systemName) ->
[hsx|<span class="px-2 py-0.5 rounded text-xs bg-emerald-100 text-emerald-800">VSM {functionName} / {vsmSystemLabel systemName}</span>|]
_ -> mempty
vsmSystemLabel :: Text -> Text
vsmSystemLabel "environment" = "Environment"
vsmSystemLabel systemName = "System " <> systemName
healthScoreBadge :: Int -> Html
healthScoreBadge s =
let cls :: Text
cls = if s >= 80 then "bg-green-100 text-green-800"
else if s >= 50 then "bg-amber-100 text-amber-800"
else "bg-red-100 text-red-700"
in [hsx|<span class={"px-2 py-0.5 rounded text-xs " <> cls}>health {tshow s}</span>|]
jsonArrayLen :: Value -> Int
jsonArrayLen (Array v) = V.length v
jsonArrayLen _ = 0