module Web.View.HubRegistry.Show where import Web.Types import Web.Controller.HubRegistry (GaafStatus(..), gaafStatus) import Generated.Types import IHP.Prelude import IHP.ViewPrelude import Data.Aeson (Value(..), encode) import qualified Data.Vector as V import qualified Data.ByteString.Lazy.Char8 as BL -- | Row from the adopted patterns query. -- (patternId, patternName, widgetType, patternHubId, adoptionId, isVersionPinned, adoptedAt) type AdoptedPatternRow = (Id WidgetPattern, Text, Text, Id Hub, Id PatternAdoption, Bool, UTCTime) data ShowView = ShowView { hub :: !Hub , mManifest :: !(Maybe HubCapabilityManifest) , healthHistory :: ![HubHealthSnapshot] , adoptedPatterns :: ![AdoptedPatternRow] } instance View ShowView where html ShowView { .. } = let gs = gaafStatus mManifest in [hsx|
← Hub Registry

{hub.name}

{hub.hubKind} {gaafBadge gs}

Domain

{hub.domain}

Capability Manifest

{manifestCell mManifest hub.id}
{case mManifest of Nothing -> [hsx|
No active manifest. Create one to register hub-owned types.
|] Just m -> [hsx|
{jsonArraySection "Widget Types" m.declaredWidgetTypes} {jsonArraySection "Event Types" m.declaredEventTypes} {jsonArraySection "Annotation Categories" m.declaredAnnotationCategories} {jsonArraySection "Policy Scopes" m.declaredPolicyScopes}
|]}

Health History

{if null healthHistory then [hsx|

No snapshots recorded yet.

|] else [hsx|
{forEach healthHistory renderSnapshotRow}
Score Open Candidates Regressed Widgets Stale Decisions Active Bottlenecks Computed At
|]}

Adopted Patterns

{if null adoptedPatterns then [hsx|

No patterns adopted yet. Browse patterns →

|] else [hsx|
{forEach adoptedPatterns renderAdoptedPattern}
|]} |] manifestCell :: Maybe HubCapabilityManifest -> Id Hub -> Html manifestCell Nothing hubId = [hsx|
None Create
|] manifestCell (Just m) _ = [hsx|
{m.manifestVersion} View
|] gaafBadge :: GaafStatus -> Html gaafBadge GaafCompliant = [hsx|GAAF compliant|] gaafBadge GaafDraftOnly = [hsx|draft manifest|] gaafBadge GaafNoManifest = [hsx|no manifest|] jsonArraySection :: Text -> Value -> Html jsonArraySection title val = [hsx|

{title} ({arrayLen val})

{renderArrayItems val}
|] renderArrayItems :: Value -> Html renderArrayItems (Array v) | V.null v = [hsx|

None declared

|] renderArrayItems (Array v) = [hsx| |] renderArrayItems _ = [hsx|

|] renderItem :: Value -> Html renderItem (String t) = [hsx|
  • {t}
  • |] renderItem v = [hsx|
  • {cs (BL.unpack (encode v)) :: Text}
  • |] arrayLen :: Value -> Text arrayLen (Array v) = tshow (V.length v) arrayLen _ = "0" renderSnapshotRow :: HubHealthSnapshot -> Html renderSnapshotRow s = [hsx| {tshow s.healthScore} {tshow s.openCandidates} {tshow s.regressedWidgets} {tshow s.staleDecisions} {tshow s.activeBottlenecks} {tshow s.computedAt} |] renderAdoptedPattern :: AdoptedPatternRow -> Html renderAdoptedPattern (patternId, patternName, widgetType, _, _, isPinned, adoptedAt) = [hsx|
    {patternName} {widgetType}
    {if isPinned then [hsx|pinned|] else [hsx|follow latest|]} {tshow adoptedAt}
    |]