module Web.View.HubRegistry.Show where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
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, 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.name}
{hub.hubKind}
{gaafBadge gs}
Capability Manifest
{manifestCell mManifest hub.id}
{manifestSection mManifest}
Health History
{renderHealthHistory healthHistory}
Adopted Patterns
{renderAdoptedPatternsSection adoptedPatterns}
|]
manifestSection :: Maybe HubCapabilityManifest -> Html
manifestSection Nothing = [hsx|
No active manifest.
Create one to register hub-owned types.
|]
manifestSection (Just m) = [hsx|
{jsonArraySection "Widget Types" m.declaredWidgetTypes}
{jsonArraySection "Event Types" m.declaredEventTypes}
{jsonArraySection "Annotation Categories" m.declaredAnnotationCategories}
{jsonArraySection "Policy Scopes" m.declaredPolicyScopes}
|]
renderAdoptedPatternsSection :: [AdoptedPatternRow] -> Html
renderAdoptedPatternsSection [] = [hsx|No patterns adopted yet. Browse patterns →
|]
renderAdoptedPatternsSection ps = [hsx|
{forEach ps renderAdoptedPattern}
|]
renderPinnedBadge :: Bool -> Html
renderPinnedBadge True = [hsx|pinned|]
renderPinnedBadge False = [hsx|follow latest|]
renderHealthHistory :: [HubHealthSnapshot] -> Html
renderHealthHistory [] = [hsx|No snapshots recorded yet.
|]
renderHealthHistory history = [hsx|
| Score |
Open Candidates |
Regressed Widgets |
Stale Decisions |
Active Bottlenecks |
Computed At |
{forEach history renderSnapshotRow}
|]
manifestCell :: Maybe HubCapabilityManifest -> Id Hub -> Html
manifestCell Nothing hubId = [hsx|
|]
manifestCell (Just m) _ = [hsx|
|]
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|
{forEach (V.toList v) renderItem}
|]
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|
{renderPinnedBadge isPinned}
{tshow adoptedAt}
|]