Files
inter-hub/Web/View/MarketplaceDashboard/Show.hs
Bernd Worsch f1978c3888 fix(WP-0014): pre-flight compilation fixes, Tailwind pipeline, and admin seed
A2 — Compilation fixes:
- Remove inline FK constraints from Schema.sql; IHP schema compiler cannot
  parse them. Add 1744329600-restore-fk-constraints.sql migration to restore
  referential integrity at the DB level.
- Rename `#label` → `#label_` throughout to avoid clash with Haskell built-in.
- Fix `hub.id == hid` UUID comparisons to use `toUUID hub.id`.
- Replace non-existent `setStatus`/`respondJson` calls with
  `renderJsonWithStatusCode` throughout Api controllers.
- Fix qualified package import for `cryptohash-sha256` in Auth.hs.
- Add `CanSelect (Text, Text)` instance in Helper.View.
- Refactor HSX inline lambdas to named helper functions in 100+ views
  (GHC cannot infer types for anonymous functions inside quasi-quoted HSX).
- Fix missing imports (IHP.QueryBuilder, IHP.Fetch, Web.Routes, Only, etc.)
  across helpers and controllers.
- Remove duplicate `diffUTCTime` definition in BottleneckDetector.
- Change `createEventForHub` return type from `IO ResponseReceived` to `IO ()`.
- Seed type-registry vocabulary via 1744502400-seed-type-registries.sql
  (moved from Schema.sql where IHP does not execute INSERT statements).

A3 — Tailwind build pipeline:
- Add `tailwindcss` to flake.nix native packages.
- Uncomment `tailwind.exec` process in devenv shell config.
- Add tailwind/tailwind.config.js (scans Web/View/**/*.hs).
- Add tailwind/app.css with @tailwind directives.

A4 — Admin user seed:
- Add 1744416000-seed-admin-user.sql: inserts admin@inter-hub.local
  with bcrypt-hashed password admin1234! (cost 10).
- Add .env.example documenting all required environment variables
  and default admin credentials.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-04 09:55:12 +00:00

171 lines
7.0 KiB
Haskell

module Web.View.MarketplaceDashboard.Show where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Data.Aeson (Value(..), decode, encode)
import qualified Data.ByteString.Lazy.Char8 as BL
type PatternRow = (WidgetPattern, Int) -- pattern + adopter_count
type TemplateRow = (GovernanceTemplate, Int) -- template + clone_count
type TrendingRow = (Id WidgetPattern, Text, Text, Int) -- id, name, widget_type, recent_adoptions
data ShowView = ShowView
{ patterns :: ![PatternRow]
, templates :: ![TemplateRow]
, trending :: ![TrendingRow]
, widgetTypeOptions :: ![(Text, Text)] -- (name, label)
, searchQuery :: !(Maybe Text)
, selectedType :: !(Maybe Text)
, sortOrder :: !Text
}
instance View ShowView where
html ShowView { .. } = [hsx|
<div class="flex items-center justify-between mb-6">
<div>
<h1 class="text-2xl font-semibold">Marketplace</h1>
<p class="text-sm text-gray-500 mt-1">
Discover and adopt reusable widget patterns and governance templates.
<a href={HubRegistryAction} class="ml-2 text-indigo-600 hover:underline">Hub Registry </a>
</p>
</div>
</div>
{searchBar searchQuery selectedType sortOrder widgetTypeOptions}
{renderTrendingSection trending}
<div class="grid grid-cols-2 gap-8">
<div>
<h2 class="text-lg font-semibold mb-3">
Widget Patterns
<span class="text-sm font-normal text-gray-400 ml-1">({tshow (length patterns)})</span>
</h2>
<div class="space-y-2">
{forEach patterns renderPatternRow}
{if null patterns then noPatternsMsg else mempty}
</div>
</div>
<div>
<h2 class="text-lg font-semibold mb-3">
Governance Templates
<span class="text-sm font-normal text-gray-400 ml-1">({tshow (length templates)})</span>
</h2>
<div class="space-y-2">
{forEach templates renderTemplateRow}
{if null templates then noTemplatesMsg else mempty}
</div>
</div>
</div>
|]
searchBar :: Maybe Text -> Maybe Text -> Text -> [(Text, Text)] -> Html
searchBar mSearch mWType sortOrder wtOptions = [hsx|
<form method="GET" action={MarketplaceDashboardAction} class="mb-6 flex items-end gap-3">
<div class="flex-1">
<label class="block text-xs text-gray-500 mb-1">Search</label>
<input type="text" name="q" value={fromMaybe "" mSearch}
placeholder="Search patterns and templates..."
class="w-full border border-gray-300 rounded px-3 py-2 text-sm" />
</div>
<div>
<label class="block text-xs text-gray-500 mb-1">Widget Type</label>
<select name="widgetType" class="border border-gray-300 rounded px-3 py-2 text-sm font-mono">
<option value="">All types</option>
{forEach wtOptions (renderWtOption mWType)}
</select>
</div>
<div>
<label class="block text-xs text-gray-500 mb-1">Sort</label>
<select name="sort" class="border border-gray-300 rounded px-3 py-2 text-sm">
<option value="adopted" selected={sortOrder == "adopted"}>Most adopted</option>
<option value="recent" selected={sortOrder == "recent"}>Recently published</option>
<option value="alpha" selected={sortOrder == "alpha"}>Alphabetical</option>
</select>
</div>
<button type="submit"
class="text-sm bg-indigo-600 text-white px-4 py-2 rounded hover:bg-indigo-700">
Search
</button>
</form>
|]
renderPatternRow :: PatternRow -> Html
renderPatternRow (pattern, adopterCount) = [hsx|
<div class="bg-white rounded border border-gray-200 p-3 hover:border-indigo-200">
<div class="flex items-center justify-between">
<a href={ShowWidgetPatternAction (pattern.id)}
class="font-medium text-sm text-indigo-700 hover:underline">
{pattern.name}
</a>
<span class="text-xs text-gray-400">{tshow adopterCount} adopters</span>
</div>
<span class="font-mono text-xs text-gray-400">{pattern.widgetType}</span>
{maybe mempty renderPatternDesc pattern.description}
</div>
|]
renderTemplateRow :: TemplateRow -> Html
renderTemplateRow (template, cloneCount) = [hsx|
<div class="bg-white rounded border border-gray-200 p-3 hover:border-indigo-200">
<div class="flex items-center justify-between">
<a href={ShowGovernanceTemplateAction (template.id)}
class="font-medium text-sm text-indigo-700 hover:underline">
{template.name}
</a>
<span class="text-xs text-gray-400">{tshow cloneCount} clones</span>
</div>
{maybe mempty renderPatternDesc template.description}
<div class="mt-1 flex flex-wrap gap-1">
{forEach (jsonArrayTexts template.categories) renderCategoryChip}
</div>
</div>
|]
renderTrendingChip :: TrendingRow -> Html
renderTrendingChip (patternId, name, widgetType, count) = [hsx|
<a href={ShowWidgetPatternAction (patternId)}
class="flex items-center gap-1.5 px-3 py-1.5 bg-white rounded border border-gray-200 \
\text-sm hover:border-indigo-300">
<span class="font-medium">{name}</span>
<span class="font-mono text-xs text-gray-400">{widgetType}</span>
<span class="text-xs text-indigo-600">{tshow count} adoptions</span>
</a>
|]
jsonArrayTexts :: Value -> [Text]
jsonArrayTexts val = case decode (encode val) of
Just (arr :: [Text]) -> arr
Nothing -> []
renderTrendingSection :: [TrendingRow] -> Html
renderTrendingSection [] = mempty
renderTrendingSection rows = [hsx|
<div class="mb-6">
<h2 class="text-sm font-semibold text-gray-600 uppercase tracking-wide mb-3">
Trending (last 30 days)
</h2>
<div class="flex flex-wrap gap-2">
{forEach rows renderTrendingChip}
</div>
</div>
|]
noPatternsMsg :: Html
noPatternsMsg = [hsx|<p class="text-sm text-gray-400">No patterns match your search.</p>|]
noTemplatesMsg :: Html
noTemplatesMsg = [hsx|<p class="text-sm text-gray-400">No templates match your search.</p>|]
renderPatternDesc :: Text -> Html
renderPatternDesc d = [hsx|<p class="text-xs text-gray-500 mt-1 truncate">{d}</p>|]
renderCategoryChip :: Text -> Html
renderCategoryChip c = [hsx|<span class="px-1.5 py-0.5 rounded text-xs bg-blue-50 text-blue-600 font-mono">{c}</span>|]
renderWtOption :: Maybe Text -> (Text, Text) -> Html
renderWtOption mWType (n, l) = [hsx|<option value={n} selected={mWType == Just n}>{l}</option>|]