module Web.View.Hubs.AdapterCompatibilityDashboard where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Application.Helper.View (adapterStatusBadge)
import Data.List (nub, sortBy)
import Data.Ord (comparing, Down(..))
data AdapterCompatibilityDashboardView = AdapterCompatibilityDashboardView
{ hub :: !Hub
, specs :: ![WidgetAdapterSpec]
, widgets :: ![Widget]
, envelopes :: ![EnvelopeEmissionContract]
, reportings :: ![InteractionReportingContract]
}
instance View AdapterCompatibilityDashboardView where
html AdapterCompatibilityDashboardView { .. } = [hsx|
Adapter Compatibility Dashboard
{hub.name}
← Hub
Adapter Specs
{kpiCard "Active" (show activeCount) "text-green-700"}
{kpiCard "Draft" (show draftCount) "text-yellow-700"}
{kpiCard "Deprecated" (show deprecatedCount) "text-gray-500"}
Widget Coverage
{length widgets}
total widgets
{adapterBacked}
adapter-backed
{nativeCount}
native IHP
{renderCoverageBar adapterBacked nativeCount}
{forEach coverageBySpec (renderCoverageSpecRow specs)}
Active Contracts
Envelope:
{forEach envelopes renderEnvelopeLink}
Reporting:
{forEach reportings renderReportingLink}
Unassigned Widgets
(no adapter_spec_id)
{renderUnassignedWidgets unassignedWidgets}
Active Adapter Specs
{renderActiveSpecsTable activeSpecs}
|]
where
activeCount = length (filter (\s -> s.status == "active") specs)
draftCount = length (filter (\s -> s.status == "draft") specs)
deprecatedCount = length (filter (\s -> s.status == "deprecated") specs)
activeSpecs = filter (\s -> s.status == "active") specs
adapterBacked = length (filter (\w -> isJust w.adapterSpecId) widgets)
nativeCount = length widgets - adapterBacked
unassignedWidgets = filter (\w -> isNothing w.adapterSpecId) widgets
-- Count widgets per adapter spec ID
coverageBySpec :: [(Id WidgetAdapterSpec, Int)]
coverageBySpec =
let assigned = [ sid | w <- widgets, Just sid <- [w.adapterSpecId] ]
specIds = nub assigned
in sortBy (comparing (Down . snd))
[ (sid, length (filter (== sid) assigned)) | sid <- specIds ]
renderCoverageSpecRow :: [WidgetAdapterSpec] -> (Id WidgetAdapterSpec, Int) -> Html
renderCoverageSpecRow ss (sid, cnt) =
let mSpec = find (\s -> s.id == sid) ss
label = maybe "(unknown)" (.name) mSpec
in [hsx|
{label}
{show cnt} widgets
|]
renderActiveSpecsTable :: [WidgetAdapterSpec] -> Html
renderActiveSpecsTable [] = [hsx|No active adapter specs.
|]
renderActiveSpecsTable ss = [hsx|
| Adapter |
Framework |
Widgets |
Status |
{forEach ss renderSpecRow}
|]
renderSpecRow :: WidgetAdapterSpec -> Html
renderSpecRow s =
let widgetCount = length (filter (\w -> w.adapterSpecId == Just s.id) widgets)
in [hsx|
|
{s.name}
|
{s.framework}
|
{show widgetCount} |
" text-xs px-2 py-0.5 rounded font-medium"}>
{s.status}
|
|]
renderEnvelopeLink :: EnvelopeEmissionContract -> Html
renderEnvelopeLink e = [hsx|
v{e.contractVersion}
|]
renderReportingLink :: InteractionReportingContract -> Html
renderReportingLink r = [hsx|
v{r.contractVersion}
|]
renderUnassignedWidgets :: [Widget] -> Html
renderUnassignedWidgets [] = [hsx|All widgets have adapter assignments.
|]
renderUnassignedWidgets ws = [hsx|
{forEach ws renderUnassignedWidgetRow}
|]
renderUnassignedWidgetRow :: Widget -> Html
renderUnassignedWidgetRow w = [hsx|
|]
kpiCard :: Text -> Text -> Text -> Html
kpiCard label value textClass = [hsx|
{label}
textClass}>{value}
|]
renderCoverageBar :: Int -> Int -> Html
renderCoverageBar adapted native =
let total = adapted + native
in if total == 0
then mempty
else
let adaptedPct = show (round ((fromIntegral adapted / fromIntegral total :: Double) * 100) :: Int) <> "%"
nativePct = show (round ((fromIntegral native / fromIntegral total :: Double) * 100) :: Int) <> "%"
in [hsx|
Adapter-backed {adaptedPct}
Native IHP {nativePct}
|]