module Web.View.Hubs.Show where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data ShowView = ShowView
{ hub :: !Hub
, widgets :: ![Widget]
, recentEvents :: ![InteractionEvent]
, recentAnnotations :: ![Annotation]
, mManifest :: !(Maybe HubCapabilityManifest)
}
instance View ShowView where
html ShowView { .. } = [hsx|
{hub.name}
{kindBadge hub.hubKind}
{classificationBadge hub}
{hub.slug}
{hub.domain}
Recent Events
{length recentEvents}
Recent Annotations
{length recentAnnotations}
Widgets
| Name |
Type |
Status |
Version |
{forEach widgets renderWidgetRow}
Recent Interaction Events
| Event |
Actor |
Occurred |
{forEach recentEvents renderEventRow}
Recent Annotations
{forEach recentAnnotations renderAnnotationCard}
Capability Manifest
{renderManifestSection mManifest hub.id}
|]
renderWidgetRow :: Widget -> Html
renderWidgetRow w = [hsx|
|
{w.name}
|
{w.widgetType} |
{w.status}
|
v{show w.version} |
|]
renderEventRow :: InteractionEvent -> Html
renderEventRow e = [hsx|
| {e.eventType} |
{e.actorType} |
{show e.occurredAt} |
|]
renderAnnotationCard :: Annotation -> Html
renderAnnotationCard a = [hsx|
{a.category}
{a.actorType}
{a.body}
|]
renderManifestSection :: Maybe HubCapabilityManifest -> Id Hub -> Html
renderManifestSection Nothing hubId = [hsx|
No capability manifest registered for this hub.
Domain hubs should declare their vocabulary before creating hub-owned type registry entries.
Register Capabilities
|]
renderManifestSection (Just m) _ = [hsx|
{manifestStatusBadge m.status}
v{m.manifestVersion}
{maybe mempty renderCapabilityDesc m.capabilityDescription}
View manifest →
{maybe mempty renderManifestContactLine m.contact}
|]
manifestStatusBadge :: Text -> Html
manifestStatusBadge "active" = [hsx|active|]
manifestStatusBadge "draft" = [hsx|draft|]
manifestStatusBadge "retired" = [hsx|retired|]
manifestStatusBadge s = [hsx|{s}|]
kindBadge :: Text -> Html
kindBadge "framework" = [hsx|framework|]
kindBadge "shared" = [hsx|shared|]
kindBadge _ = [hsx|domain|]
classificationBadge :: Hub -> Html
classificationBadge hub =
case (hub.hubFamily, hub.vsmFunction, hub.vsmSystem) of
(Just "vsm", Just functionName, Just systemName) ->
[hsx|VSM {functionName} / {vsmSystemLabel systemName}|]
_ -> mempty
vsmSystemLabel :: Text -> Text
vsmSystemLabel "environment" = "Environment"
vsmSystemLabel systemName = "System " <> systemName
maybeText :: Maybe Text -> [Text]
maybeText Nothing = []
maybeText (Just t) = [t]
renderCapabilityDesc :: Text -> Html
renderCapabilityDesc d = [hsx|— {d}|]
renderManifestContactLine :: Text -> Html
renderManifestContactLine c = [hsx|Contact: {c}
|]