diff --git a/.changeset/reativa-components-package.md b/.changeset/reativa-components-package.md new file mode 100644 index 0000000..fcb4516 --- /dev/null +++ b/.changeset/reativa-components-package.md @@ -0,0 +1,20 @@ +--- +"@xpecs/reativa": minor +--- + +Add `@xpecs/reativa` — the ReasonML/OCaml (reativa + Melange) sibling of +`@xpecs/xote`, as its own package. + +- Implements the same set `@xpecs/xote` covers — 22 elements, 8 components, and + 7 blocks — in `.mlx` (JSX-for-OCaml) over `Reativa.View`, styled against + `@xpecs/tokens`, with the same behaviour and accessibility semantics as the + Xote components. +- Enum prop types (`variant`, `size`, …) are generated from the specs' `## API` + contracts into `src/Contracts.ml` by `npm run contracts`, so the OCaml + compiler enforces that the implementation can't drift from the spec — the same + guarantee `@xpecs/xote` has. +- `src/Registry.mlx` renders one live example per spec and exports the JS surface + the website's **Reativa** preview consumes (`mount_example`, `example_ids`, + `built`). The website's example block now has two tab strips: one picks the + view (Preview / Playground / Code) and one picks the implementation rendered in + the preview (**Xote** or **Reativa**). diff --git a/package-lock.json b/package-lock.json index 9536bfd..c4c8245 100644 --- a/package-lock.json +++ b/package-lock.json @@ -525,6 +525,10 @@ "undici-types": "~8.3.0" } }, + "node_modules/@xpecs/reativa": { + "resolved": "packages/reativa", + "link": true + }, "node_modules/@xpecs/skill": { "resolved": "skill", "link": true @@ -1495,6 +1499,14 @@ "resolved": "website", "link": true }, + "packages/reativa": { + "name": "@xpecs/reativa", + "version": "0.1.0", + "license": "MIT", + "dependencies": { + "@xpecs/tokens": "^0.1.0" + } + }, "packages/tokens": { "name": "@xpecs/tokens", "version": "0.1.0", diff --git a/packages/reativa/.gitignore b/packages/reativa/.gitignore new file mode 100644 index 0000000..60370ed --- /dev/null +++ b/packages/reativa/.gitignore @@ -0,0 +1,4 @@ +.build/ +dist/ +_build/ +node_modules/ diff --git a/packages/reativa/README.md b/packages/reativa/README.md new file mode 100644 index 0000000..39900bd --- /dev/null +++ b/packages/reativa/README.md @@ -0,0 +1,65 @@ +# @xpecs/reativa + +Accessible UI components for **[reativa](https://github.com/brnrdog/reativa)** +(OCaml + Melange) that implement the [Xpecs](https://github.com/brnrdog/ux-archetypes) +contracts — the ReasonML/OCaml sibling of +[`@xpecs/xote`](../xote). Every element, component, and block is written in +`.mlx` (JSX-for-OCaml) over `Reativa.View`, styled against +[`@xpecs/tokens`](../tokens), so a re-theme cascades through these exactly like +it does through the Xote components. + +There is no virtual DOM: `View.mount` builds real DOM nodes once and only the +reactive regions (driven by signals) update in place. + +## What's implemented + +The same set `@xpecs/xote` covers — 22 elements, 8 components, and 7 blocks: + +| Layer | Specs | +| ----- | ----- | +| element | `aspect-ratio` `avatar` `badge` `button` `checkbox` `icon` `icon-button` `input` `input-otp` `kbd` `link` `progress` `radio-group` `scroll-area` `separator` `skeleton` `slider` `spinner` `switch` `textarea` `toggle` `toggle-group` | +| component | `accordion` `alert` `collapsible` `dialog` `field` `select` `tabs` `tooltip` | +| block | `announcement-bar` `contact-section` `logo-cloud` `newsletter` `page-header` `stat-grid` `steps` | + +Each component is a plain function — `Button.make ~variant:\`primary ~children ()` +— and composes the others. Enum prop types (`variant`, `size`, …) are generated +from the specs' `## API` contracts into [`src/Contracts.ml`](src/Contracts.ml) +by `npm run contracts`, so the OCaml compiler enforces that the implementation +can't drift from the spec's allowed values. + +[`src/Registry.mlx`](src/Registry.mlx) renders one live example per spec (the +same demos as the website's Xote examples) and exports the JS surface the +website consumes: `mount_example(specId, containerId)`, `example_ids`, and +`built`. + +## Building + +reativa's core library has **no `public_name`**, so it is a *private* dune +library that can't be consumed as an installed opam package — its own demo +builds only because it lives inside the reativa dune project. So we do the same: +[`scripts/build.mjs`](scripts/build.mjs) clones reativa (pinned to a commit), +drops [`dune`](dune) + `src/*` into a subdirectory of the clone where the +private `reativa` library and the `reativa.mlx_ppx` ppx are in scope, compiles +to ES modules with Melange, and bundles the emitted `Registry.js` into +`dist/reativa.bundle.js` with esbuild. + +Requires the OCaml toolchain (an opam switch on OCaml **5.1+**, since reativa +needs `melange >= 3`). One-time setup: + +```bash +opam switch create . 5.2.1 # or reuse an existing 5.1+ switch +opam install dune melange mlx +``` + +Then: + +```bash +npm run build --workspace @xpecs/reativa # contracts → melange → esbuild bundle +``` + +To move to a newer reativa, bump `REATIVA_REF` in `scripts/build.mjs`. + +> This build is intentionally **not** part of `npm run build:packages` (it needs +> opam/melange, which the rest of the build does not) — but CI runs it, and the +> website's `npm run reativa` builds this package and copies the bundle into the +> site so the **Reativa** preview ships for real. diff --git a/packages/reativa/dune b/packages/reativa/dune new file mode 100644 index 0000000..de1a911 --- /dev/null +++ b/packages/reativa/dune @@ -0,0 +1,19 @@ +; Compiles the reativa component sources (this directory's *.mlx / *.ml) to +; JavaScript ES modules under output/. The emitted entry (output/Registry.js) +; re-exports mount_example / example_ids / built and is bundled for the browser +; with esbuild by `node scripts/build.mjs`; see README.md. +; +; This dune file is copied, together with the src/ modules, into a subdirectory +; of a pinned clone of the reativa repo (which ships the private `reativa` +; library and the reativa.mlx_ppx ppx) — reativa's core has no public_name, so +; it can't be consumed as an installed opam library and must be built in-tree. +; +; Each source module carries a `[@@@warning "-a"]` floating attribute so a stray +; unused binding never fails the build under dune's dev profile; genuine type +; errors are still errors. +(melange.emit + (target output) + (libraries reativa) + (preprocess + (pps reativa.mlx_ppx melange.ppx)) + (module_systems es6)) diff --git a/packages/reativa/package.json b/packages/reativa/package.json new file mode 100644 index 0000000..0fafee6 --- /dev/null +++ b/packages/reativa/package.json @@ -0,0 +1,40 @@ +{ + "name": "@xpecs/reativa", + "version": "0.1.0", + "description": "Accessible UI components for Reativa (OCaml + Melange) that implement the Xpecs contracts — the ReasonML/OCaml sibling of @xpecs/xote. Styled against @xpecs/tokens; prop types are generated from the spec API contracts, so the implementation can't drift from the spec.", + "license": "MIT", + "author": "brnrdog", + "keywords": [ + "ocaml", + "reason", + "melange", + "reativa", + "components", + "ui", + "design-system", + "ux-archetypes", + "accessibility" + ], + "type": "module", + "files": [ + "src", + "dune", + "README.md" + ], + "scripts": { + "contracts": "node scripts/generate-contracts.mjs", + "build": "npm run contracts && node scripts/build.mjs", + "prepack": "npm run contracts" + }, + "dependencies": { + "@xpecs/tokens": "^0.1.0" + }, + "repository": { + "type": "git", + "url": "https://github.com/brnrdog/ux-archetypes", + "directory": "packages/reativa" + }, + "publishConfig": { + "access": "public" + } +} diff --git a/packages/reativa/scripts/build.mjs b/packages/reativa/scripts/build.mjs new file mode 100644 index 0000000..5a400ef --- /dev/null +++ b/packages/reativa/scripts/build.mjs @@ -0,0 +1,91 @@ +// Build the @xpecs/reativa component bundle (consumed by the website's Reativa +// tab). reativa's core library is a *private* dune library (no public_name), so +// it can't be consumed as an installed opam library — its own demo works only +// because it lives inside the reativa dune project. We do the same: clone +// reativa (pinned), drop this package's `dune` + src/ modules into a +// subdirectory of that project so the private `reativa` library and the +// `reativa.mlx_ppx` ppx resolve, compile to JS with Melange, then bundle the +// emitted entry (Registry.js) into dist/reativa.bundle.js with esbuild. +// +// Requires: an opam switch with `dune`, `melange`, `mlx` installed, plus git and +// esbuild. Not part of `npm run build:packages`/the website's default build +// (it needs opam/melange, which the rest of the build does not) — invoked +// explicitly by `npm run build --workspace @xpecs/reativa`, and by CI so PRs +// compile the components and Pages ships the real bundle. + +import { execFileSync } from "node:child_process"; +import { + existsSync, + mkdirSync, + copyFileSync, + readdirSync, +} from "node:fs"; +import { resolve, join } from "node:path"; +import { fileURLToPath } from "node:url"; + +const REATIVA_REPO = "https://github.com/brnrdog/reativa.git"; +// Pin a known-good commit so the build is reproducible. Bump deliberately. +const REATIVA_REF = "c94697df4bcd16fae59f900a01f7c60964606492"; + +const pkgDir = resolve(fileURLToPath(import.meta.url), "../.."); +const srcDir = resolve(pkgDir, "src"); +const buildDir = resolve(pkgDir, ".build"); +const clone = resolve(buildDir, "reativa"); +// The subdirectory inside the reativa dune project we drop our sources into. +const exDir = resolve(clone, "xpecs_reativa"); +const distDir = resolve(pkgDir, "dist"); + +const sh = (file, args, cwd) => execFileSync(file, args, { cwd, stdio: "inherit" }); + +// 1. Clone reativa (or reuse a previous clone) and check out the pinned commit. +mkdirSync(buildDir, { recursive: true }); +if (!existsSync(resolve(clone, ".git"))) { + sh("git", ["clone", REATIVA_REPO, "reativa"], buildDir); +} +sh("git", ["fetch", "--quiet", "origin"], clone); +sh("git", ["checkout", "--quiet", REATIVA_REF], clone); + +// 2. Drop this package's dune + every src module into the reativa project (same +// dune-project ⇒ the private `reativa` library and reativa.mlx_ppx are in +// scope, and the `.mlx` dialect is available). +mkdirSync(exDir, { recursive: true }); +copyFileSync(resolve(pkgDir, "dune"), resolve(exDir, "dune")); +for (const name of readdirSync(srcDir)) { + if (name.endsWith(".mlx") || name.endsWith(".ml") || name.endsWith(".mli")) { + copyFileSync(resolve(srcDir, name), resolve(exDir, name)); + } +} + +// 3. Compile the components (and reativa itself) to ES modules via Melange. +sh("opam", ["exec", "--", "dune", "build", "@melange"], clone); + +// 4. Bundle the emitted entry (Registry.js) into a single ES module. melange.emit +// mirrors the source path under the target dir, so the entry is normally +// //output/Registry.js — but locate it defensively in case +// the nesting differs across dune/melange versions. +const outputRoot = resolve(clone, "_build/default/xpecs_reativa/output"); +const findEntry = (dir) => { + for (const name of readdirSync(dir, { withFileTypes: true })) { + const p = join(dir, name.name); + if (name.isDirectory()) { + const hit = findEntry(p); + if (hit) return hit; + } else if (name.name === "Registry.js") { + return p; + } + } + return null; +}; +const entry = findEntry(outputRoot); +if (!entry) { + throw new Error(`could not find emitted Registry.js under ${outputRoot}`); +} +mkdirSync(distDir, { recursive: true }); +const outfile = resolve(distDir, "reativa.bundle.js"); +sh( + "npx", + ["--yes", "esbuild", entry, "--bundle", "--format=esm", `--outfile=${outfile}`], + pkgDir, +); + +console.log(`\n✓ @xpecs/reativa bundle written to ${outfile}`); diff --git a/packages/reativa/scripts/generate-contracts.mjs b/packages/reativa/scripts/generate-contracts.mjs new file mode 100644 index 0000000..16e1365 --- /dev/null +++ b/packages/reativa/scripts/generate-contracts.mjs @@ -0,0 +1,77 @@ +// Generates src/Contracts.ml from the `## API` blocks in the spec markdown. +// For every enum prop it emits an OCaml polymorphic-variant type, grouped in a +// module named after the spec. Components annotate their props with these +// types, so the OCaml compiler itself enforces that the implementation stays in +// sync with the contract's allowed values. +// +// This is the OCaml counterpart of packages/xote/scripts/generate-contracts.mjs +// (which emits ReScript polymorphic variants for @xpecs/xote); both read the +// same specs so the two implementations expose the same contract types. +import { readFileSync, writeFileSync, readdirSync, mkdirSync } from "node:fs"; +import { join, dirname, basename } from "node:path"; +import { fileURLToPath } from "node:url"; + +const here = dirname(fileURLToPath(import.meta.url)); +const specsDir = join(here, "..", "..", "..", "specs"); +const outFile = join(here, "..", "src", "Contracts.ml"); +const layers = ["elements", "components", "blocks", "pages", "flows"]; + +// OCaml keywords that can't be bare type names — suffixed with `_` if hit. +const reserved = new Set([ + "and", "as", "assert", "begin", "class", "constraint", "do", "done", "downto", + "else", "end", "exception", "external", "false", "for", "fun", "function", + "functor", "if", "in", "include", "inherit", "initializer", "lazy", "let", + "match", "method", "module", "mutable", "new", "nonrec", "object", "of", "open", + "or", "private", "rec", "sig", "struct", "then", "to", "true", "try", "type", + "val", "virtual", "when", "while", "with", +]); +const typeName = (n) => (reserved.has(n) ? `${n}_` : n); +const pascal = (id) => + id + .split("-") + .map((p) => p.charAt(0).toUpperCase() + p.slice(1)) + .join(""); + +function apiOf(body) { + const m = body.match(/^##\s+API\s*$/m); + if (!m) return null; + const fence = body.slice(m.index).match(/```json\s*([\s\S]*?)```/); + if (!fence) return null; + return JSON.parse(fence[1]); +} + +const modules = []; +for (const layerDir of layers) { + let files; + try { + files = readdirSync(join(specsDir, layerDir)).filter((f) => f.endsWith(".md")); + } catch { + continue; + } + for (const file of files.sort()) { + const raw = readFileSync(join(specsDir, layerDir, file), "utf8"); + const api = apiOf(raw); + if (!api || !Array.isArray(api.props)) continue; + const enums = api.props.filter((p) => p.type === "enum" && p.values?.length); + if (enums.length === 0) continue; + const id = basename(file, ".md"); + const types = enums + .map( + (p) => + ` type ${typeName(p.name)} = [ ${p.values.map((v) => `\`${v}`).join(" | ")} ]`, + ) + .join("\n"); + modules.push(`module ${pascal(id)} = struct\n${types}\nend`); + } +} + +const out = `(* GENERATED FILE — do not edit by hand. + Run \`npm run contracts\` (scripts/generate-contracts.mjs) to regenerate. + Types are derived from the \`## API\` contracts in the spec markdown. *) + +${modules.join("\n\n")} +`; + +mkdirSync(dirname(outFile), { recursive: true }); +writeFileSync(outFile, out); +console.log(`Wrote ${modules.length} contract module(s) to ${outFile}`); diff --git a/packages/reativa/src/Accordion.mlx b/packages/reativa/src/Accordion.mlx new file mode 100644 index 0000000..0e284d8 --- /dev/null +++ b/packages/reativa/src/Accordion.mlx @@ -0,0 +1,35 @@ +[@@@warning "-a"] + +(* Accordion — a stack of headers that expand/collapse their panels. [type_] + (from the contract) selects single- vs multiple-open behavior; [collapsible] + controls whether the open panel can be closed again. Open state is the list of + open ids held in the [value] signal. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(type_ : Contracts.Accordion.type_ = `single) ?(collapsible = true) ~value ~items () = + let toggle id = + Signal.update value (fun cur -> + let is_open = List.mem id cur in + match (type_, is_open) with + | _, true -> if collapsible then List.filter (fun x -> x <> id) cur else cur + | `single, false -> [ id ] + | `multiple, false -> cur @ [ id ]) + in + let render (id, header, panel) = + let is_open () = List.mem id (Signal.get value) in + let mark () = if List.mem id (Signal.get value) then "\xe2\x88\x92" else "+" in +
+ + (View.show is_open (

(panel)

)) +
+ in +
+ (View.fragment (List.map render items)) +
\ No newline at end of file diff --git a/packages/reativa/src/Alert.mlx b/packages/reativa/src/Alert.mlx new file mode 100644 index 0000000..58978ef --- /dev/null +++ b/packages/reativa/src/Alert.mlx @@ -0,0 +1,50 @@ +[@@@warning "-a"] + +(* Alert — an inline message drawing attention to contextual information. The + [variant] type comes from the spec's `## API` contract (Contracts.ml), so the + compiler enforces the spec's allowed severities. Severity is conveyed by the + semantic status hues (and the glyph, so color is never the only cue). *) + +open Reativa +open Reativa.View.Mlx + +let make ?(variant : Contracts.Alert.variant = `info) ?(icon = "") ~title ~description () = + (* A per-variant default glyph, used when no explicit [icon] name is given. *) + let icon_name = + if icon = "" then + match variant with + | `info -> "info" + | `success -> "check-circle" + | `warning -> "alert-triangle" + | `danger -> "alert-circle" + else icon + in + let border = + match variant with + | `info -> "border-status-info" + | `success -> "border-status-success" + | `warning -> "border-status-warning" + | `danger -> "border-status-danger" + in + let icon_color = + match variant with + | `info -> "text-status-info" + | `success -> "text-status-success" + | `warning -> "text-status-warning" + | `danger -> "text-status-danger" + in + View.element + ~attrs: + [ + View.Attr.make "role" (View.static "alert"); + View.Attr.className + (View.static ("flex gap-3 rounded-lg border bg-surface p-4 text-sm text-ink " ^ border)); + ] + "div" + [ + (Icon.make ~name:icon_name ()); +
+

(title)

+

(description)

+
; + ] \ No newline at end of file diff --git a/packages/reativa/src/AnnouncementBar.mlx b/packages/reativa/src/AnnouncementBar.mlx new file mode 100644 index 0000000..29ab1c8 --- /dev/null +++ b/packages/reativa/src/AnnouncementBar.mlx @@ -0,0 +1,56 @@ +[@@@warning "-a"] + +(* Announcement Bar — a slim, page-width strip carrying one timely message, with + an optional action link and a dismiss control. The [variant] type comes from + the spec's `## API` contract (Contracts.ml). Dismissal hides the bar and + notifies [on_dismiss] so the owner can persist the choice. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(variant : Contracts.AnnouncementBar.variant = `neutral) ?(action_label = "") + ?(action_href = "#") ?on_dismiss ~message () = + let open_ = Signal.make true in + let dismiss _ = + Signal.set open_ false; + match on_dismiss with Some f -> f () | None -> () + in + let surface, icon_name, icon_cls = + match variant with + | `neutral -> ("border-b border-border bg-surface text-ink", "info", "text-muted") + | `accent -> ("bg-accent text-accent-contrast", "zap", "text-accent-contrast") + | `warning -> + ("border-b border-status-warning bg-surface text-ink", "alert-triangle", "text-status-warning") + in + let link_cls = + match variant with + | `accent -> "font-medium underline underline-offset-2 hover:opacity-80" + | `neutral | `warning -> + "font-medium text-ink underline underline-offset-2 hover:text-muted" + in + View.show + (fun () -> Signal.get open_) + (View.element + ~attrs: + [ + View.Attr.className + (View.static + ("flex w-full flex-wrap items-center justify-center gap-x-3 gap-y-1 px-4 py-2 text-sm " + ^ surface)); + ] + "div" + [ + (Icon.make ~name:icon_name ~size:`sm ()); +

(message)

; + (if action_label = "" then View.empty + else + View.element + ~attrs: + [ View.Attr.href (View.static action_href); View.Attr.className (View.static link_cls) ] + "a" + [ View.text (View.static action_label) ]); + + (IconButton.make ~label:"Dismiss announcement" ~variant:`ghost ~on_click:dismiss + ~children:[ Icon.make ~name:"x" ~size:`sm () ] ()) + ; + ]) \ No newline at end of file diff --git a/packages/reativa/src/AspectRatio.mlx b/packages/reativa/src/AspectRatio.mlx new file mode 100644 index 0000000..9faf557 --- /dev/null +++ b/packages/reativa/src/AspectRatio.mlx @@ -0,0 +1,12 @@ +[@@@warning "-a"] + +(* AspectRatio — constrains its content to a fixed width:height proportion. + Implements the `aspect-ratio` spec. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(ratio = "16/9") ?(extra_class = "") ~children () = +
+ (View.fragment children) +
\ No newline at end of file diff --git a/packages/reativa/src/Avatar.mlx b/packages/reativa/src/Avatar.mlx new file mode 100644 index 0000000..70c9014 --- /dev/null +++ b/packages/reativa/src/Avatar.mlx @@ -0,0 +1,14 @@ +[@@@warning "-a"] + +(* Avatar — a person/entity glyph with an initials fallback. Reused by hover-card + and others. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(size = "size-10 text-sm") ~initials () = + + (initials) + \ No newline at end of file diff --git a/packages/reativa/src/Backdrop.mlx b/packages/reativa/src/Backdrop.mlx new file mode 100644 index 0000000..ef19403 --- /dev/null +++ b/packages/reativa/src/Backdrop.mlx @@ -0,0 +1,10 @@ +[@@@warning "-a"] + +(* Backdrop — a full-screen click-catcher that dismisses an open overlay. Reused + by Select, dropdown-menu, popover, and others. *) + +open Reativa +open Reativa.View.Mlx + +let make ~on_close () = +
on_close ()) /> \ No newline at end of file diff --git a/packages/reativa/src/Badge.mlx b/packages/reativa/src/Badge.mlx new file mode 100644 index 0000000..58ddb2f --- /dev/null +++ b/packages/reativa/src/Badge.mlx @@ -0,0 +1,19 @@ +[@@@warning "-a"] + +(* Badge — a compact status/category label. Reused by card, table, and others. + The [variant] type comes from the spec's `## API` contract (Contracts.ml), + so the compiler enforces the spec's allowed values. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(variant : Contracts.Badge.variant = `solid) ~children () = + let tone = + match variant with + | `solid -> "bg-neutral-900 text-neutral-0" + | `soft -> "bg-neutral-200 text-neutral-800" + | `outline -> "border border-neutral-300 text-neutral-700" + in + + (View.fragment children) + \ No newline at end of file diff --git a/packages/reativa/src/Button.mlx b/packages/reativa/src/Button.mlx new file mode 100644 index 0000000..1bed64b --- /dev/null +++ b/packages/reativa/src/Button.mlx @@ -0,0 +1,37 @@ +[@@@warning "-a"] + +(* Button — the reusable action control. Reused by the card, dialog, form, + navbar, and other examples. Its [variant]/[size]/[type_] prop types come from + the spec's `## API` contract (Contracts.ml, generated), so the compiler + enforces that this implementation stays in sync with the spec's allowed + values — exactly as @xpecs/xote's Button does. *) + +open Reativa + +let make ?(variant : Contracts.Button.variant = `primary) ?(size : Contracts.Button.size = `md) + ?(type_ : Contracts.Button.type_ = `button) ?(disabled = false) ?(loading = false) ?on_click + ?(extra_class = "") ~children () = + let type_str = match type_ with `button -> "button" | `submit -> "submit" | `reset -> "reset" in + let size_cls = match size with `sm -> Ui.btn_sm | `md -> Ui.btn_md | `lg -> Ui.btn_lg in + let colors = + match variant with + | `primary -> Ui.btn_primary_colors + | `secondary -> Ui.btn_secondary_colors + | `ghost -> Ui.btn_ghost_colors + | `destructive -> Ui.btn_destructive_colors + in + (* Dark-surface variants need an on-accent spinner; light ones use ink. *) + let spinner_tone = + match variant with `primary | `destructive -> `on_accent | `secondary | `ghost -> `ink + in + let cls = Ui.cx (Ui.btn_core ^ " " ^ size_cls ^ " " ^ colors) extra_class in + let attrs = + [ + View.Attr.type_ (View.static type_str); + View.Attr.className (View.static cls); + View.Attr.disabled (fun () -> disabled || loading); + ] + in + let events = match on_click with Some f -> [ View.On.click f ] | None -> [] in + let spinner = if loading then Spinner.make ~tone:spinner_tone () else View.empty in + View.element ~attrs ~events "button" [ spinner; View.fragment children ] \ No newline at end of file diff --git a/packages/reativa/src/Checkbox.mlx b/packages/reativa/src/Checkbox.mlx new file mode 100644 index 0000000..329e729 --- /dev/null +++ b/packages/reativa/src/Checkbox.mlx @@ -0,0 +1,57 @@ +[@@@warning "-a"] + +(* Checkbox — a controlled tick box bound to a signal, with an optional label and + description. Implements the `checkbox` spec. + + [indeterminate] is a property-only DOM state (announced as "mixed"), so an + indeterminate box gets a generated id and the property is set after render. + The browser clears it on the first user toggle, as the spec expects. *) + +open Reativa +open Reativa.View.Mlx + +(* Unique ids for indeterminate boxes — the DOM property is set post-render. *) +let seq = ref 0 + +let make ?(indeterminate = false) ?(disabled = false) ?(required = false) ?(label = "") + ?(description = "") ?on_change ~checked () = + let handle ev = + Signal.set checked (Ui.checked ev); + match on_change with Some f -> f ev | None -> () + in + let id = + if indeterminate then begin + incr seq; + let id = "xpecs-reativa-checkbox-" ^ string_of_int !seq in + Ui.set_indeterminate_by_id id true; + Some id + end + else None + in + let input_attrs = + [ + View.Attr.type_ (View.static "checkbox"); + View.Attr.checked (View.dynamic (fun () -> Signal.get checked)); + View.Attr.className (View.static "mt-0.5 size-4 accent-neutral-900 disabled:opacity-40"); + View.Attr.disabled (fun () -> disabled); + View.Attr.toggle "required" (fun () -> required); + ] + in + let input_attrs = + match id with Some i -> View.Attr.id (View.static i) :: input_attrs | None -> input_attrs + in + let input_node = View.element ~attrs:input_attrs ~events:[ View.On.change handle ] "input" [] in + let text_node = + if label = "" && description = "" then View.empty + else + + (if label = "" then View.empty + else (label)) + (if description = "" then View.empty + else (description)) + + in + \ No newline at end of file diff --git a/packages/reativa/src/Collapsible.mlx b/packages/reativa/src/Collapsible.mlx new file mode 100644 index 0000000..56f70bf --- /dev/null +++ b/packages/reativa/src/Collapsible.mlx @@ -0,0 +1,29 @@ +[@@@warning "-a"] + +(* Collapsible — a single region that expands/collapses to show or hide content. + Controlled via an [open_] signal (the contract's `open` prop); the trigger + label and the collapsible content are passed in. Reuses Button. *) + +open Reativa +open Reativa.View.Mlx + +let make ~open_ ~label ~children () = + let caret () = if Signal.get open_ then "\xe2\x8c\x83" else "\xe2\x8c\x84" in +
+ (Button.make ~variant:`secondary ~extra_class:"w-full justify-between" + ~on_click:(fun _ -> Signal.update open_ (fun v -> not v)) + ~children: + [ + View.text (View.static label); + View.element + ~attrs:[ View.Attr.className (View.static "text-neutral-400") ] + "span" + [ View.dyn_text caret ]; + ] + ()) + (View.show + (fun () -> Signal.get open_) + (
+ (View.fragment children) +
)) +
\ No newline at end of file diff --git a/packages/reativa/src/ContactSection.mlx b/packages/reativa/src/ContactSection.mlx new file mode 100644 index 0000000..5ed7aea --- /dev/null +++ b/packages/reativa/src/ContactSection.mlx @@ -0,0 +1,105 @@ +[@@@warning "-a"] + +(* Contact Section — a short message form beside direct contact channels. Field + values live in internal signals; submit prevents the default, hands + (name, email, message) to [on_submit], and shows the success confirmation in + place with a status region so the outcome is announced. Each detail is + (icon, label, href) and renders as a real link. Reuses Field, Input, Textarea, + Button, Icon. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(description = "") ?(details = []) ?on_submit ~heading () = + let name = Signal.make "" in + let email = Signal.make "" in + let message = Signal.make "" in + let sent = Signal.make false in + let submit ev = + Ui.prevent_default ev; + (match on_submit with + | Some f -> f (Signal.get name, Signal.get email, Signal.get message) + | None -> ()); + Signal.set sent true + in + let detail_row (icon, label, href) = + View.element ~attrs:[] "li" + [ + View.element + ~attrs: + [ + View.Attr.href (View.static href); + View.Attr.className (View.static "group inline-flex items-center gap-3 text-sm text-ink"); + ] + "a" + [ + + (Icon.make ~name:icon ()) + ; + (label); + ]; + ] + in + let form_node = + View.element + ~attrs:[ View.Attr.className (View.static "mt-6 space-y-4") ] + ~events:[ View.On.submit submit ] + "form" + [ +
+ (Field.make ~label:"Name" ~for_:"contact-name" + ~children: + [ + Input.make ~id:"contact-name" ~placeholder:"Ada Lovelace" ~required:true + ~on_input:(fun e -> Signal.set name (Ui.input_value e)) + (); + ] + ()) + (Field.make ~label:"Email" ~for_:"contact-email" + ~children: + [ + Input.make ~id:"contact-email" ~type_:"email" ~placeholder:"ada@example.com" + ~required:true + ~on_input:(fun e -> Signal.set email (Ui.input_value e)) + (); + ] + ()) +
; + (Field.make ~label:"Message" ~for_:"contact-message" + ~children: + [ + Textarea.make ~id:"contact-message" ~rows:4 ~required:true ~extra_class:"resize-none" + ~placeholder:"How can we help?" ~value:message (); + ] + ()); + (Button.make ~type_:`submit ~variant:`primary + ~children:[ View.text (View.static "Send message") ] ()); + (View.element + ~attrs:[ View.Attr.make "role" (View.static "status") ] + "div" + [ + View.show + (fun () -> Signal.get sent) + (

+ ("Thanks \xe2\x80\x94 your message is on its way. We reply within one business day.") +

); + ]); + ] + in + View.element + ~attrs:[ View.Attr.className (View.static "grid w-full gap-10 md:grid-cols-5") ] + "section" + [ +
+

(heading)

+ (if description = "" then View.empty + else

(description)

) + (form_node) +
; + (if details = [] then View.empty + else + View.element + ~attrs:[ View.Attr.className (View.static "space-y-4 md:col-span-2 md:pt-12") ] + "ul" + (List.map detail_row details)); + ] \ No newline at end of file diff --git a/packages/reativa/src/Contracts.ml b/packages/reativa/src/Contracts.ml new file mode 100644 index 0000000..b32d7c5 --- /dev/null +++ b/packages/reativa/src/Contracts.ml @@ -0,0 +1,115 @@ +[@@@warning "-a"] + +(* GENERATED FILE — do not edit by hand. + Run `npm run contracts` (scripts/generate-contracts.mjs) to regenerate. + Types are derived from the `## API` contracts in the spec markdown. *) + +module Badge = struct + type variant = [ `solid | `soft | `outline ] +end + +module Button = struct + type variant = [ `primary | `secondary | `ghost | `destructive ] + type size = [ `sm | `md | `lg ] + type type_ = [ `button | `submit | `reset ] +end + +module IconButton = struct + type variant = [ `solid | `ghost ] +end + +module Icon = struct + type size = [ `xs | `sm | `md | `lg | `xl ] +end + +module Link = struct + type variant = [ `default | `muted ] +end + +module RadioGroup = struct + type orientation = [ `vertical | `horizontal ] +end + +module ScrollArea = struct + type orientation = [ `vertical | `horizontal | `both ] +end + +module Separator = struct + type orientation = [ `horizontal | `vertical ] +end + +module Skeleton = struct + type shape = [ `text | `circle | `rect ] +end + +module ToggleGroup = struct + type type_ = [ `single | `multiple ] +end + +module Typography = struct + type variant = [ `h1 | `h2 | `h3 | `h4 | `body | `small | `muted | `code ] +end + +module Accordion = struct + type type_ = [ `single | `multiple ] +end + +module Alert = struct + type variant = [ `info | `success | `warning | `danger ] +end + +module ButtonGroup = struct + type orientation = [ `horizontal | `vertical ] +end + +module Calendar = struct + type mode = [ `single | `range | `multiple ] +end + +module Carousel = struct + type orientation = [ `horizontal | `vertical ] +end + +module Chart = struct + type type_ = [ `bar | `line | `area | `pie ] +end + +module Drawer = struct + type side = [ `left | `right | `top | `bottom ] +end + +module Resizable = struct + type orientation = [ `horizontal | `vertical ] +end + +module Sheet = struct + type side = [ `left | `right | `top | `bottom ] +end + +module Stat = struct + type trend = [ `up | `down | `flat ] +end + +module Tabs = struct + type orientation = [ `horizontal | `vertical ] +end + +module Toast = struct + type variant = [ `info | `success | `warning | `danger ] +end + +module Toolbar = struct + type orientation = [ `horizontal | `vertical ] +end + +module AnnouncementBar = struct + type variant = [ `neutral | `accent | `warning ] +end + +module PricingTable = struct + type interval = [ `monthly | `yearly ] +end + +module Steps = struct + type orientation = [ `horizontal | `vertical ] +end \ No newline at end of file diff --git a/packages/reativa/src/Dialog.mlx b/packages/reativa/src/Dialog.mlx new file mode 100644 index 0000000..1026b6f --- /dev/null +++ b/packages/reativa/src/Dialog.mlx @@ -0,0 +1,30 @@ +[@@@warning "-a"] + +(* Dialog — a modal overlay focusing the user on a self-contained task. + Controlled via the [open_] signal (the contract prop); the header/body/footer + are passed as children. Backdrop click dismisses. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(description = "") ~open_ ~title ~children () = + View.show + (fun () -> Signal.get open_) + (
+
Signal.set open_ false) /> + (View.element + ~attrs: + [ + View.Attr.make "role" (View.static "dialog"); + View.Attr.className + (View.static + "relative z-20 w-80 rounded-lg border border-neutral-200 bg-surface p-5 shadow-2xl"); + ] + "div" + [ +

(title)

; + (if description = "" then View.empty + else

(description)

); + View.fragment children; + ]) +
) \ No newline at end of file diff --git a/packages/reativa/src/Field.mlx b/packages/reativa/src/Field.mlx new file mode 100644 index 0000000..6dbf6f2 --- /dev/null +++ b/packages/reativa/src/Field.mlx @@ -0,0 +1,25 @@ +[@@@warning "-a"] + +(* Field — pairs a label with a control (and optional hint). Reused by form, + dialog, and the input/textarea examples. [for] is not one of the attributes + the mlx element helper exposes, so the label is built with [View.element]. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(hint = "") ~label ~for_ ~children () = + let label_node = + View.element + ~attrs:[ View.Attr.className (View.static Ui.label); View.Attr.make "for" (View.static for_) ] + "label" + [ View.text (View.static label) ] + in + let hint_node = + if hint = "" then View.empty + else

(hint)

+ in +
+ (label_node) + (View.fragment children) + (hint_node) +
\ No newline at end of file diff --git a/packages/reativa/src/Icon.ml b/packages/reativa/src/Icon.ml new file mode 100644 index 0000000..a43b143 --- /dev/null +++ b/packages/reativa/src/Icon.ml @@ -0,0 +1,47 @@ +[@@@warning "-a"] + +(* Icon — renders a named glyph from [Icons] as inline SVG. Color and weight are + inherited from the surrounding text (stroke=currentColor), so an icon sits + naturally beside a label. [size] maps to the optical size scale; pass [label] + to give a meaningful icon an accessible name — omit it and the icon is + treated as decorative and hidden from assistive tech. + + reativa's View layer creates nodes with [document.createElement] (HTML + namespace), which can't produce a rendering []; so the glyph is injected + as [innerHTML] on a host [] (see [Ui.set_inner_html_by_id]), which the + browser parses in the SVG namespace and which still inherits [currentColor]. + Callers use it as a plain function: [Icon.make ~name:"check" ()]. + + The host span is built inside a [View.dyn] region so the innerHTML is + scheduled at *insert* time (with a fresh id) rather than at build time — an + icon inside an initially-hidden region (e.g. a Newsletter success state) then + still gets its markup when the region is first shown. *) + +open Reativa + +(* Fresh host ids so multiple icons of the same name never collide. *) +let counter = ref 0 + +let make ?(size : Contracts.Icon.size = `md) ?(label = "") ?(extra_class = "") ~name () = + let dims = + match size with + | `xs -> "size-3" + | `sm -> "size-4" + | `md -> "size-5" + | `lg -> "size-6" + | `xl -> "size-8" + in + let body = match Icons.get name with Some b -> b | None -> [] in + let meaningful = label <> "" in + (* Meaningful icons expose an img role + accessible name; decorative ones are + hidden so assistive tech doesn't announce them beside their label. *) + let role_attrs = + if meaningful then "role=\"img\" aria-label=\"" ^ label ^ "\"" else "aria-hidden=\"true\"" + in + let extra = if extra_class = "" then "" else " " ^ extra_class in + let markup = Icons.svg ~dims ~extra ~role_attrs body in + View.dyn (fun () -> + incr counter; + let id = "xpecs-reativa-icon-" ^ string_of_int !counter in + Ui.set_inner_html_by_id id markup; + View.element ~attrs:[ View.Attr.id (View.static id) ] "span" []) \ No newline at end of file diff --git a/packages/reativa/src/IconButton.mlx b/packages/reativa/src/IconButton.mlx new file mode 100644 index 0000000..f7cf3a7 --- /dev/null +++ b/packages/reativa/src/IconButton.mlx @@ -0,0 +1,26 @@ +[@@@warning "-a"] + +(* IconButton — a compact, icon-only action with a required accessible name. + Reused by toolbar, list, and other dense contexts. *) + +open Reativa + +let make ?(variant : Contracts.IconButton.variant = `ghost) ?on_click ~label ~children () = + let tone = + match variant with + | `solid -> "bg-action text-on-action hover:bg-action-hover" + | `ghost -> "text-ink hover:bg-action-subtle" + in + let attrs = + [ + View.Attr.type_ (View.static "button"); + View.Attr.make "aria-label" (View.static label); + View.Attr.className + (View.static + ("inline-flex size-9 items-center justify-center rounded-md text-sm transition-colors \ + focus-visible:outline-none focus-visible:ring-2 focus-visible:ring-action \ + focus-visible:ring-offset-2 " ^ tone)); + ] + in + let events = match on_click with Some f -> [ View.On.click f ] | None -> [] in + View.element ~attrs ~events "button" [ View.fragment children ] \ No newline at end of file diff --git a/packages/reativa/src/Icons.ml b/packages/reativa/src/Icons.ml new file mode 100644 index 0000000..5a2a9cc --- /dev/null +++ b/packages/reativa/src/Icons.ml @@ -0,0 +1,186 @@ +[@@@warning "-a"] + +(* Icons — the same small outline icon set as @xpecs/xote's [Icons], in the + Feather / Lucide visual language: every glyph is drawn on a 24×24 grid with + no fill, 2px strokes, and round caps and joins, so it inherits the + surrounding text color and optical weight. The geometry lives here as data + (one entry per name); [svg] turns a glyph into inline SVG markup that the + [Icon] element injects. Glyph paths adapted from Feather Icons (MIT). *) + +(* A single drawing primitive. Keeping circles, lines, and polylines as first- + class shapes (rather than flattening everything to a path [d]) keeps the + glyphs faithful to the source set and easy to read. *) +type prim = + | Path of string + | Circle of float * float * float (* cx, cy, r *) + | Line of float * float * float * float (* x1, y1, x2, y2 *) + | Polyline of string (* points *) + | Polygon of string (* points *) + | Rect of float * float * float * float * float * float (* x, y, w, h, rx, ry *) + +(* name → geometry. Names follow the conventional icon vocabulary (kebab-case, + concept-not-appearance) so they read the same across projects. *) +let registry : (string * prim list) list = + [ + (* Confirm / dismiss *) + ("check", [ Polyline "20 6 9 17 4 12" ]); + ("x", [ Line (18., 6., 6., 18.); Line (6., 6., 18., 18.) ]); + (* Chevrons *) + ("chevron-down", [ Polyline "6 9 12 15 18 9" ]); + ("chevron-up", [ Polyline "18 15 12 9 6 15" ]); + ("chevron-left", [ Polyline "15 18 9 12 15 6" ]); + ("chevron-right", [ Polyline "9 18 15 12 9 6" ]); + (* Arrows *) + ("arrow-right", [ Line (5., 12., 19., 12.); Polyline "12 5 19 12 12 19" ]); + ("arrow-left", [ Line (19., 12., 5., 12.); Polyline "12 19 5 12 12 5" ]); + ("arrow-up", [ Line (12., 19., 12., 5.); Polyline "5 12 12 5 19 12" ]); + ("arrow-down", [ Line (12., 5., 12., 19.); Polyline "19 12 12 19 5 12" ]); + (* Add / remove *) + ("plus", [ Line (12., 5., 12., 19.); Line (5., 12., 19., 12.) ]); + ("minus", [ Line (5., 12., 19., 12.) ]); + (* Common actions *) + ("search", [ Circle (11., 11., 8.); Line (21., 21., 16.65, 16.65) ]); + ( "trash", + [ + Polyline "3 6 5 6 21 6"; + Path "M19 6v14a2 2 0 0 1-2 2H7a2 2 0 0 1-2-2V6m3 0V4a2 2 0 0 1 2-2h4a2 2 0 0 1 2 2v2"; + Line (10., 11., 10., 17.); + Line (14., 11., 14., 17.); + ] ); + ("edit", [ Path "M17 3a2.828 2.828 0 1 1 4 4L7.5 20.5 2 22l1.5-5.5L17 3z" ]); + ( "copy", + [ + Rect (9., 9., 13., 13., 2., 2.); + Path "M5 15H4a2 2 0 0 1-2-2V4a2 2 0 0 1 2-2h9a2 2 0 0 1 2 2v1"; + ] ); + ( "download", + [ + Path "M21 15v4a2 2 0 0 1-2 2H5a2 2 0 0 1-2-2v-4"; + Polyline "7 10 12 15 17 10"; + Line (12., 15., 12., 3.); + ] ); + ( "upload", + [ + Path "M21 15v4a2 2 0 0 1-2 2H5a2 2 0 0 1-2-2v-4"; + Polyline "17 8 12 3 7 8"; + Line (12., 3., 12., 15.); + ] ); + ( "external-link", + [ + Path "M18 13v6a2 2 0 0 1-2 2H5a2 2 0 0 1-2-2V8a2 2 0 0 1 2-2h6"; + Polyline "15 3 21 3 21 9"; + Line (10., 14., 21., 3.); + ] ); + (* Menus / overflow *) + ("menu", [ Line (3., 12., 21., 12.); Line (3., 6., 21., 6.); Line (3., 18., 21., 18.) ]); + ("more-horizontal", [ Circle (12., 12., 1.); Circle (19., 12., 1.); Circle (5., 12., 1.) ]); + ("more-vertical", [ Circle (12., 12., 1.); Circle (12., 5., 1.); Circle (12., 19., 1.) ]); + (* Status *) + ("info", [ Circle (12., 12., 10.); Line (12., 16., 12., 12.); Line (12., 8., 12.01, 8.) ]); + ( "alert-triangle", + [ + Path "M10.29 3.86 1.82 18a2 2 0 0 0 1.71 3h16.94a2 2 0 0 0 1.71-3L13.71 3.86a2 2 0 0 0-3.42 0z"; + Line (12., 9., 12., 13.); + Line (12., 17., 12.01, 17.); + ] ); + ("alert-circle", [ Circle (12., 12., 10.); Line (12., 8., 12., 12.); Line (12., 16., 12.01, 16.) ]); + ( "check-circle", + [ Path "M22 11.08V12a10 10 0 1 1-5.93-9.14"; Polyline "22 4 12 14.01 9 11.01" ] ); + ("x-circle", [ Circle (12., 12., 10.); Line (15., 9., 9., 15.); Line (9., 9., 15., 15.) ]); + (* Objects *) + ("user", [ Path "M20 21v-2a4 4 0 0 0-4-4H8a4 4 0 0 0-4 4v2"; Circle (12., 7., 4.) ]); + ( "settings", + [ + Circle (12., 12., 3.); + Path + "M19.4 15a1.65 1.65 0 0 0 .33 1.82l.06.06a2 2 0 0 1-2.83 2.83l-.06-.06a1.65 1.65 0 0 0-1.82-.33 1.65 1.65 0 0 0-1 1.51V21a2 2 0 0 1-4 0v-.09A1.65 1.65 0 0 0 9 19.4a1.65 1.65 0 0 0-1.82.33l-.06.06a2 2 0 0 1-2.83-2.83l.06-.06a1.65 1.65 0 0 0 .33-1.82 1.65 1.65 0 0 0-1.51-1H3a2 2 0 0 1 0-4h.09A1.65 1.65 0 0 0 4.6 9a1.65 1.65 0 0 0-.33-1.82l-.06-.06a2 2 0 0 1 2.83-2.83l.06.06a1.65 1.65 0 0 0 1.82.33H9a1.65 1.65 0 0 0 1-1.51V3a2 2 0 0 1 4 0v.09a1.65 1.65 0 0 0 1 1.51 1.65 1.65 0 0 0 1.82-.33l.06-.06a2 2 0 0 1 2.83 2.83l-.06.06a1.65 1.65 0 0 0-.33 1.82V9a1.65 1.65 0 0 0 1.51 1H21a2 2 0 0 1 0 4h-.09a1.65 1.65 0 0 0-1.51 1z"; + ] ); + ("bell", [ Path "M18 8A6 6 0 0 0 6 8c0 7-3 9-3 9h18s-3-2-3-9"; Path "M13.73 21a2 2 0 0 1-3.46 0" ]); + ( "heart", + [ + Path + "M20.84 4.61a5.5 5.5 0 0 0-7.78 0L12 5.67l-1.06-1.06a5.5 5.5 0 0 0-7.78 7.78l1.06 1.06L12 21.23l7.78-7.78 1.06-1.06a5.5 5.5 0 0 0 0-7.78z"; + ] ); + ( "star", + [ Polygon "12 2 15.09 8.26 22 9.27 17 14.14 18.18 21.02 12 17.77 5.82 21.02 7 14.14 2 9.27 8.91 8.26 12 2" ] ); + ("home", [ Path "M3 9l9-7 9 7v11a2 2 0 0 1-2 2H5a2 2 0 0 1-2-2z"; Polyline "9 22 9 12 15 12 15 22" ]); + ( "inbox", + [ + Polyline "22 12 16 12 14 15 10 15 8 12 2 12"; + Path "M5.45 5.11 2 12v6a2 2 0 0 0 2 2h16a2 2 0 0 0 2-2v-6l-3.45-6.89A2 2 0 0 0 16.76 4H7.24a2 2 0 0 0-1.79 1.11z"; + ] ); + ("mail", [ Path "M4 4h16c1.1 0 2 .9 2 2v12c0 1.1-.9 2-2 2H4c-1.1 0-2-.9-2-2V6c0-1.1.9-2 2-2z"; Polyline "22 6 12 13 2 6" ]); + ( "calendar", + [ Rect (3., 4., 18., 18., 2., 2.); Line (16., 2., 16., 6.); Line (8., 2., 8., 6.); Line (3., 10., 21., 10.) ] ); + ("clock", [ Circle (12., 12., 10.); Polyline "12 6 12 12 16 14" ]); + ("eye", [ Path "M1 12s4-8 11-8 11 8 11 8-4 8-11 8-11-8-11-8z"; Circle (12., 12., 3.) ]); + ( "eye-off", + [ + Path + "M17.94 17.94A10.07 10.07 0 0 1 12 20c-7 0-11-8-11-8a18.45 18.45 0 0 1 5.06-5.94M9.9 4.24A9.12 9.12 0 0 1 12 4c7 0 11 8 11 8a18.5 18.5 0 0 1-2.16 3.19m-6.72-1.07a3 3 0 1 1-4.24-4.24"; + Line (1., 1., 23., 23.); + ] ); + (* Feature / marketing *) + ("zap", [ Polygon "13 2 3 14 12 14 11 22 21 10 12 10 13 2" ]); + ("lock", [ Rect (3., 11., 18., 11., 2., 2.); Path "M7 11V7a5 5 0 0 1 10 0v4" ]); + ("trending-up", [ Polyline "23 6 13.5 15.5 8.5 10.5 1 18"; Polyline "17 6 23 6 23 12" ]); + ("target", [ Circle (12., 12., 10.); Circle (12., 12., 6.); Circle (12., 12., 2.) ]); + ( "maximize", + [ Path "M8 3H5a2 2 0 0 0-2 2v3m18 0V5a2 2 0 0 0-2-2h-3m0 18h3a2 2 0 0 0 2-2v-3M3 16v3a2 2 0 0 0 2 2h3" ] ); + ( "github", + [ + Path + "M9 19c-5 1.5-5-2.5-7-3m14 6v-3.87a3.37 3.37 0 0 0-.94-2.61c3.14-.35 6.44-1.54 6.44-7A5.44 5.44 0 0 0 20 4.77 5.07 5.07 0 0 0 19.91 1S18.73.65 16 2.48a13.38 13.38 0 0 0-7 0C6.27.65 5.09 1 5.09 1A5.07 5.07 0 0 0 5 4.77a5.44 5.44 0 0 0-1.5 3.78c0 5.42 3.3 6.61 6.44 7A3.37 3.37 0 0 0 9 18.13V22"; + ] ); + (* Text alignment (toolbar) *) + ("align-left", [ Line (17., 10., 3., 10.); Line (21., 6., 3., 6.); Line (21., 14., 3., 14.); Line (17., 18., 3., 18.) ]); + ("align-center", [ Line (18., 10., 6., 10.); Line (21., 6., 3., 6.); Line (21., 14., 3., 14.); Line (18., 18., 6., 18.) ]); + ("align-right", [ Line (21., 10., 7., 10.); Line (21., 6., 3., 6.); Line (21., 14., 3., 14.); Line (21., 18., 7., 18.) ]); + (* Theme *) + ( "sun", + [ + Circle (12., 12., 5.); + Line (12., 1., 12., 3.); + Line (12., 21., 12., 23.); + Line (4.22, 4.22, 5.64, 5.64); + Line (18.36, 18.36, 19.78, 19.78); + Line (1., 12., 3., 12.); + Line (21., 12., 23., 12.); + Line (4.22, 19.78, 5.64, 18.36); + Line (18.36, 5.64, 19.78, 4.22); + ] ); + ("moon", [ Path "M21 12.79A9 9 0 1 1 11.21 3 7 7 0 0 0 21 12.79z" ]); + ] + +(* Geometry for a name, or None when the name isn't in the set. *) +let get (name : string) : prim list option = List.assoc_opt name registry + +(* Every icon name in the set, sorted for a stable catalogue order. *) +let names : string list = List.sort String.compare (List.map fst registry) + +(* Format a coordinate, dropping OCaml's trailing "." on whole numbers. *) +let fmt f = + let s = string_of_float f in + let n = String.length s in + if n > 0 && s.[n - 1] = '.' then String.sub s 0 (n - 1) else s + +let shape = function + | Path d -> "" + | Circle (cx, cy, r) -> + "" + | Line (x1, y1, x2, y2) -> + "" + | Polyline points -> "" + | Polygon points -> "" + | Rect (x, y, w, h, rx, ry) -> + "" + +(* Build the inline-SVG markup for a glyph. [role_attrs] carries the + accessibility attributes (an img role + name, or aria-hidden). *) +let svg ~dims ~extra ~role_attrs body = + "" + ^ String.concat "" (List.map shape body) + ^ "" \ No newline at end of file diff --git a/packages/reativa/src/Input.mlx b/packages/reativa/src/Input.mlx new file mode 100644 index 0000000..7d2bbc2 --- /dev/null +++ b/packages/reativa/src/Input.mlx @@ -0,0 +1,21 @@ +[@@@warning "-a"] + +(* Input — a single-line text field. Reused by form, field, dialog, and filters. + Left visually uncontrolled; hand it an [on_input] to observe changes. *) + +open Reativa + +let make ?(type_ = "text") ?id ?(placeholder = "") ?value ?(required = false) ?on_input + ?(extra_class = "") () = + let attrs = + [ + View.Attr.type_ (View.static type_); + View.Attr.placeholder (View.static placeholder); + View.Attr.className (View.static (Ui.cx Ui.input_base extra_class)); + View.Attr.toggle "required" (fun () -> required); + ] + in + let attrs = match id with Some i -> View.Attr.id (View.static i) :: attrs | None -> attrs in + let attrs = match value with Some v -> View.Attr.value (View.static v) :: attrs | None -> attrs in + let events = match on_input with Some f -> [ View.On.input f ] | None -> [] in + View.element ~attrs ~events "input" [] \ No newline at end of file diff --git a/packages/reativa/src/InputOtp.mlx b/packages/reativa/src/InputOtp.mlx new file mode 100644 index 0000000..e1f0565 --- /dev/null +++ b/packages/reativa/src/InputOtp.mlx @@ -0,0 +1,49 @@ +[@@@warning "-a"] + +(* InputOtp — a segmented one-time-code field bound to a signal. A single + transparent input captures keystrokes; the cells mirror the entered digits. + Implements the `input-otp` spec. *) + +open Reativa + +let digits_only s = + let r = ref "" in + String.iter (fun c -> if c >= '0' && c <= '9' then r := !r ^ String.make 1 c) s; + !r + +let make ?(length = 6) ?(disabled = false) ~value () = + let input_node = + View.element + ~attrs: + [ + View.Attr.className + (View.static "absolute inset-0 z-10 cursor-pointer opacity-0 disabled:cursor-not-allowed"); + View.Attr.type_ (View.static "text"); + View.Attr.make "maxlength" (View.static (string_of_int length)); + View.Attr.disabled (fun () -> disabled); + ] + ~events: + [ + View.On.input (fun ev -> + let d = digits_only (Ui.input_value ev) in + let d = if String.length d > length then String.sub d 0 length else d in + Signal.set value d); + ] + "input" [] + in + let cell i = + let cls () = + let len = String.length (Signal.get value) in + "flex size-11 items-center justify-center rounded-md border text-lg font-semibold text-neutral-900 " + ^ if len = i then "border-neutral-900 ring-1 ring-neutral-900" else "border-neutral-300" + in + let ch () = + let v = Signal.get value in + if i < String.length v then String.make 1 v.[i] else "" + in + View.element ~attrs:[ View.Attr.class_reactive cls ] "span" [ View.text (View.dynamic ch) ] + in + let cells = List.init length cell in + View.element + ~attrs:[ View.Attr.className (View.static "relative inline-flex gap-2") ] + "label" (input_node :: cells) \ No newline at end of file diff --git a/packages/reativa/src/Kbd.mlx b/packages/reativa/src/Kbd.mlx new file mode 100644 index 0000000..c302c2d --- /dev/null +++ b/packages/reativa/src/Kbd.mlx @@ -0,0 +1,12 @@ +[@@@warning "-a"] + +(* Kbd — an inline keyboard-key glyph. Reused by command and shortcut hints. *) + +open Reativa +open Reativa.View.Mlx + +let make ~children () = + + (View.fragment children) + \ No newline at end of file diff --git a/packages/reativa/src/Link.mlx b/packages/reativa/src/Link.mlx new file mode 100644 index 0000000..79b8321 --- /dev/null +++ b/packages/reativa/src/Link.mlx @@ -0,0 +1,27 @@ +[@@@warning "-a"] + +(* Link — the reusable navigation control. Reused by navbar, breadcrumb, footer, + sign-in, and pagination. [new_tab] opens in a new tab; [target] is not one of + the attributes the mlx element helper exposes, so the anchor is built with the + lower-level [View.element ~attrs] API when needed. *) + +open Reativa + +let make ?(href = "#") ?(variant : Contracts.Link.variant = `default) ?(new_tab = false) + ?(extra_class = "") ~children () = + let base = + match variant with + | `default -> + "text-neutral-900 underline decoration-neutral-300 underline-offset-4 hover:decoration-neutral-900" + | `muted -> "text-neutral-500 transition-colors hover:text-neutral-900" + in + let attrs = + [ + View.Attr.href (View.static href); + View.Attr.className (View.static (Ui.cx base extra_class)); + ] + in + let attrs = + if new_tab then View.Attr.make "target" (View.static "_blank") :: attrs else attrs + in + View.element ~attrs "a" [ View.fragment children ] \ No newline at end of file diff --git a/packages/reativa/src/LogoCloud.mlx b/packages/reativa/src/LogoCloud.mlx new file mode 100644 index 0000000..9e37685 --- /dev/null +++ b/packages/reativa/src/LogoCloud.mlx @@ -0,0 +1,41 @@ +[@@@warning "-a"] + +(* Logo Cloud — a quiet band of customer/partner marks that lends credibility at + a glance. Marks render as optically-equal wordmarks in a single muted tone so + no brand dominates; each carries its company name for assistive tech. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(heading = "") ~logos () = + let logo_item name = + View.element ~attrs:[] "li" + [ + View.element + ~attrs: + [ + View.Attr.make "role" (View.static "img"); + View.Attr.make "aria-label" (View.static name); + View.Attr.className + (View.static "text-lg font-semibold tracking-tight text-neutral-400 select-none"); + ] + "span" + [ View.text (View.static name) ]; + ] + in + View.element + ~attrs:[ View.Attr.className (View.static "w-full py-6 text-center") ] + "section" + [ + (if heading = "" then View.empty + else +

(heading)

); + View.element + ~attrs: + [ + View.Attr.className + (View.static "flex flex-wrap items-center justify-center gap-x-10 gap-y-5"); + ] + "ul" + (List.map logo_item logos); + ] \ No newline at end of file diff --git a/packages/reativa/src/Newsletter.mlx b/packages/reativa/src/Newsletter.mlx new file mode 100644 index 0000000..3fedcd7 --- /dev/null +++ b/packages/reativa/src/Newsletter.mlx @@ -0,0 +1,69 @@ +[@@@warning "-a"] + +(* Newsletter — a one-field email-capture band. Submit prevents the default, + hands the address to [on_subscribe], and swaps the form for an announced + confirmation — the spec's success state. The visible heading and an explicit + aria-label keep the field labelled without a floating label. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(description = "") ?(consent = "") ?on_subscribe ~heading () = + let email = Signal.make "" in + let done_ = Signal.make false in + let submit ev = + Ui.prevent_default ev; + (match on_subscribe with Some f -> f (Signal.get email) | None -> ()); + Signal.set done_ true + in + let form_node = + View.element + ~attrs: + [ + View.Attr.className + (View.static "mx-auto mt-5 flex w-full max-w-md flex-col gap-2 sm:flex-row"); + ] + ~events:[ View.On.submit submit ] + "form" + [ + View.element + ~attrs: + [ + View.Attr.type_ (View.static "email"); + View.Attr.toggle "required" (fun () -> true); + View.Attr.make "aria-label" (View.static "Email address"); + View.Attr.placeholder (View.static "you@example.com"); + View.Attr.className (View.static (Ui.input_base ^ " flex-1")); + ] + ~events:[ View.On.input (fun e -> Signal.set email (Ui.input_value e)) ] + "input" []; + (Button.make ~type_:`submit ~variant:`primary + ~children:[ View.text (View.static "Subscribe") ] ()); + ] + in + View.element + ~attrs: + [ + View.Attr.className + (View.static "w-full rounded-2xl border border-border bg-surface p-8 text-center"); + ] + "section" + [ +

(heading)

; + (if description = "" then View.empty + else

(description)

); + (View.show (fun () -> not (Signal.get done_)) form_node); + (View.element + ~attrs:[ View.Attr.make "role" (View.static "status") ] + "div" + [ + View.show + (fun () -> Signal.get done_) + (

+ (Icon.make ~name:"check-circle" ()) + ("Almost there \xe2\x80\x94 check your inbox to confirm.") +

); + ]); + (if consent = "" then View.empty + else

(consent)

); + ] \ No newline at end of file diff --git a/packages/reativa/src/PageHeader.mlx b/packages/reativa/src/PageHeader.mlx new file mode 100644 index 0000000..0dd6943 --- /dev/null +++ b/packages/reativa/src/PageHeader.mlx @@ -0,0 +1,56 @@ +[@@@warning "-a"] + +(* Page Header — opens an application view: an optional breadcrumb trail, the + view's single h1 with a line of context, and the view's actions (passed as + children, e.g. Buttons), aligned opposite the title. A breadcrumb entry with + an empty href renders as the current page. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(description = "") ?(breadcrumb = []) ~title ~children () = + let crumb_item (label, href) = + let inner = + if href = "" then (label) + else + + (label) + (Icon.make ~name:"chevron-right" ~size:`xs ()) + + in +
  • (inner)
    • + in + let breadcrumb_node = + if breadcrumb = [] then View.empty + else + View.element + ~attrs: + [ + View.Attr.make "aria-label" (View.static "Breadcrumb"); + View.Attr.className (View.static "mb-1.5"); + ] + "nav" + [ + View.element + ~attrs:[ View.Attr.className (View.static "flex items-center gap-1.5 text-xs text-muted") ] + "ul" + (List.map crumb_item breadcrumb); + ] + in + View.element + ~attrs: + [ + View.Attr.className + (View.static + "flex w-full flex-wrap items-start justify-between gap-x-6 gap-y-4 border-b border-border pb-5"); + ] + "header" + [ +
    + (breadcrumb_node) +

    (title)

    + (if description = "" then View.empty + else

    (description)

    ) +
    ; +
    (View.fragment children)
    ; + ] \ No newline at end of file diff --git a/packages/reativa/src/Progress.mlx b/packages/reativa/src/Progress.mlx new file mode 100644 index 0000000..fe09a18 --- /dev/null +++ b/packages/reativa/src/Progress.mlx @@ -0,0 +1,33 @@ +[@@@warning "-a"] + +(* Progress — a determinate or indeterminate progress bar bound to an int + signal. Implements the `progress` spec. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(max = 100) ?(indeterminate = false) ?(extra_class = "") ~value () = + let bar () = + let pct = if max <= 0 then 0 else Signal.get value * 100 / max in + let clamped = if pct < 0 then 0 else if pct > 100 then 100 else pct in + "height:100%;width:" ^ string_of_int clamped ^ "%" + in + let inner = + if indeterminate then
    + else + View.element + ~attrs: + [ + View.Attr.className (View.static "rounded-full bg-neutral-900 transition-all"); + View.Attr.make "style" (View.dynamic bar); + ] + "div" [] + in + View.element + ~attrs: + [ + View.Attr.className + (View.static (Ui.cx "h-2 w-full overflow-hidden rounded-full bg-neutral-200" extra_class)); + View.Attr.make "role" (View.static "progressbar"); + ] + "div" [ inner ] \ No newline at end of file diff --git a/packages/reativa/src/RadioGroup.mlx b/packages/reativa/src/RadioGroup.mlx new file mode 100644 index 0000000..7e6e3fa --- /dev/null +++ b/packages/reativa/src/RadioGroup.mlx @@ -0,0 +1,97 @@ +[@@@warning "-a"] + +(* RadioGroup — mutually exclusive options bound to a signal. Each option is a + (value, label, description) triple. Implements the `radio-group` spec: every + row wraps a visually-hidden native radio so the group gets native semantics — + shared [name] grouping, arrow-key navigation, and checked announcements. *) + +open Reativa + +(* Fallback names so ungrouped instances never collide with each other. *) +let seq = ref 0 + +let make ?(legend = "") ?(name = "") ?(orientation : Contracts.RadioGroup.orientation = `vertical) + ?(disabled = false) ?(extra_class = "") ~value ~options () = + let group_name = + if name = "" then begin + incr seq; + "xpecs-reativa-radio-group-" ^ string_of_int !seq + end + else name + in + let list_cls = + match orientation with `vertical -> "space-y-2" | `horizontal -> "flex flex-wrap gap-2" + in + let render (id, title, desc) = + let is_checked () = Signal.get value = id in + let row_cls () = + "flex cursor-pointer items-start gap-3 rounded-md border p-3 transition-colors " + ^ + if Signal.get value = id then "border-neutral-900 bg-neutral-50" + else "border-neutral-200 hover:border-neutral-300" + in + let ring () = + "mt-0.5 flex size-4 items-center justify-center rounded-full border peer-focus-visible:ring-2 \ + peer-focus-visible:ring-action peer-focus-visible:ring-offset-2 " + ^ if Signal.get value = id then "border-neutral-900" else "border-neutral-300" + in + let dot () = + "size-2 rounded-full " ^ if Signal.get value = id then "bg-neutral-900" else "bg-transparent" + in + let input_node = + View.element + ~attrs: + [ + View.Attr.type_ (View.static "radio"); + View.Attr.make "name" (View.static group_name); + View.Attr.value (View.static id); + View.Attr.className (View.static "peer sr-only"); + View.Attr.checked (View.dynamic is_checked); + View.Attr.disabled (fun () -> disabled); + ] + ~events:[ View.On.change (fun _ -> Signal.set value id) ] + "input" [] + in + let text_node = + View.element ~attrs:[] "span" + [ + View.element + ~attrs:[ View.Attr.className (View.static "block text-sm font-medium text-neutral-800") ] + "span" + [ View.text (View.static title) ]; + (if desc = "" then View.empty + else + View.element + ~attrs:[ View.Attr.className (View.static "block text-xs text-neutral-500") ] + "span" + [ View.text (View.static desc) ]); + ] + in + View.element ~attrs:[ View.Attr.class_reactive row_cls ] "label" + [ + input_node; + View.element ~attrs:[ View.Attr.class_reactive ring ] "span" + [ View.element ~attrs:[ View.Attr.class_reactive dot ] "span" [] ]; + text_node; + ] + in + let fieldset_cls = extra_class ^ if disabled then " pointer-events-none opacity-50" else "" in + let legend_node = + if legend = "" then View.empty + else + View.element + ~attrs:[ View.Attr.className (View.static "mb-1 text-sm font-medium text-neutral-800") ] + "legend" + [ View.text (View.static legend) ] + in + let list_node = + View.element ~attrs:[ View.Attr.className (View.static list_cls) ] "div" (List.map render options) + in + View.element + ~attrs: + [ + View.Attr.className (View.static fieldset_cls); + View.Attr.make "role" (View.static "radiogroup"); + ] + "fieldset" + [ legend_node; list_node ] \ No newline at end of file diff --git a/packages/reativa/src/Registry.mlx b/packages/reativa/src/Registry.mlx new file mode 100644 index 0000000..bcb41e0 --- /dev/null +++ b/packages/reativa/src/Registry.mlx @@ -0,0 +1,527 @@ +[@@@warning "-a"] + +(* Registry — per-spec example compositions plus the JS surface the website + consumes. Each [*_example] function renders the same demo as the Xote + Examples in the website (website/src/Examples.res), built from the reativa + components in this package, so the site can show the two implementations side + by side. [mount_example], [example_ids] and [built] are the ES exports the + website's reativa.bundle.js is built from (see packages/reativa/scripts/ + build.mjs and website/src/ReativaExamples.res). *) + +(* Capture this package's Link component before `open Reativa`, which exposes + Router's [Link] and would otherwise shadow it. *) +module Link_ = Link + +open Reativa +open Reativa.View.Mlx + +let txt s = View.text (View.static s) + +(* ------------------------------------------------------------------ *) +(* elements *) +(* ------------------------------------------------------------------ *) + +let button_example () = + let loading = Signal.make false in +
    + (Button.make ~variant:`primary ~children:[ txt "Primary" ] ()) + (Button.make ~variant:`secondary ~children:[ txt "Secondary" ] ()) + (Button.make ~variant:`ghost ~children:[ txt "Ghost" ] ()) + (Button.make ~variant:`destructive ~children:[ txt "Delete" ] ()) + (Button.make ~variant:`secondary ~disabled:true ~children:[ txt "Disabled" ] ()) + (Button.make ~variant:`primary + ~on_click:(fun _ -> + Signal.set loading true; + Ui.set_timeout (fun () -> Signal.set loading false) 1200) + ~children: + [ + View.show ~fallback:(txt "Save") + (fun () -> Signal.get loading) + (View.fragment [ Spinner.make ~tone:`on_accent (); txt "Saving\xe2\x80\xa6" ]); + ] + ()) +
    + +let input_example () = + let value = Signal.make "" in +
    + (Field.make ~label:"Email" ~for_:"ex-email" + ~children: + [ + Input.make ~id:"ex-email" ~type_:"email" ~placeholder:"you@example.com" + ~on_input:(fun e -> Signal.set value (Ui.input_value e)) + (); + ] + ()) +

    + ("You typed: ") + (View.dyn_text (fun () -> Signal.get value)) +

    +
    + +let textarea_example () = + let value = Signal.make "" in +
    + (Field.make ~label:"Message" ~for_:"ex-ta" + ~children:[ Textarea.make ~id:"ex-ta" ~rows:4 ~value ~placeholder:"Write something\xe2\x80\xa6" () ] + ()) +

    + (View.dyn_text (fun () -> string_of_int (String.length (Signal.get value)))) + (" characters") +

    +
    + +let badge_example () = +
    + (Badge.make ~variant:`solid ~children:[ txt "Default" ] ()) + (Badge.make ~variant:`soft ~children:[ txt "Secondary" ] ()) + (Badge.make ~variant:`outline ~children:[ txt "Outline" ] ()) + (Badge.make ~variant:`soft + ~children: + [ ; txt "Idle" ] + ()) + (Badge.make ~variant:`solid ~children:[ txt "99+" ] ()) +
    + +let avatar_example () = +
    + (Avatar.make ~initials:"BG" ~size:"size-10 text-sm" ()) + (Avatar.make ~initials:"AK" ~size:"size-12" ()) +
    + (Avatar.make ~initials:"JD" ~size:"size-9 text-xs" ()) + (Avatar.make ~initials:"MP" ~size:"size-9 text-xs" ()) + (Avatar.make ~initials:"RM" ~size:"size-9 text-xs" ()) + + ("+3") + +
    +
    + +let checkbox_example () = + let on = Signal.make true in + Checkbox.make ~checked:on ~label:"Subscribe" ~description:"Get product updates by email." () + +let switch_example () = + let checked = Signal.make false in + Switch.make ~checked ~label:"Airplane mode" () + +let slider_example () = + let value = Signal.make 40 in +
    +
    + ("Volume") + + (View.dyn_text (fun () -> string_of_int (Signal.get value))) + ("%") + +
    + (Slider.make ~value ()) +
    + +let progress_example () = + let value = Signal.make 30 in +
    + (Progress.make ~value ()) +
    + (Button.make ~variant:`secondary + ~on_click:(fun _ -> Signal.update value (fun v -> if v > 10 then v - 10 else 0)) + ~children:[ txt "\xe2\x88\x9210" ] ()) + (Button.make ~variant:`secondary + ~on_click:(fun _ -> Signal.update value (fun v -> if v < 90 then v + 10 else 100)) + ~children:[ txt "+10" ] ()) +
    +
    + +let spinner_example () = +
    + (Spinner.make ~size:"size-4" ()) + (Spinner.make ~size:"size-6" ()) + (Spinner.make ~size:"size-8" ()) + ("Loading\xe2\x80\xa6") +
    + +let skeleton_example () = +
    +
    + (Skeleton.make ~shape:`circle ~extra_class:"size-10" ()) +
    + (Skeleton.make ~extra_class:"w-1/2" ()) + (Skeleton.make ~extra_class:"w-1/3" ()) +
    +
    + (Skeleton.make ~extra_class:"w-full" ()) + (Skeleton.make ~extra_class:"w-5/6" ()) +
    + +let separator_example () = +
    +

    ("Above the line")

    + (Separator.make ~extra_class:"my-3" ()) +
    + ("Home") + (Separator.make ~orientation:`vertical ()) + ("Docs") + (Separator.make ~orientation:`vertical ()) + ("About") +
    +
    + +let kbd_example () = +
    + ("Open search") + (Kbd.make ~children:[ txt "\xe2\x8c\x98" ] ()) + (Kbd.make ~children:[ txt "K" ] ()) +
    + +let icon_example () = +
    + (Icon.make ~name:"search" ~size:`lg ()) + (Icon.make ~name:"bell" ~size:`lg ()) + (Icon.make ~name:"settings" ~size:`lg ()) + (Icon.make ~name:"heart" ~size:`lg ()) + (Icon.make ~name:"star" ~size:`lg ()) + (Icon.make ~name:"github" ~size:`lg ()) +
    + +let icon_button_example () = +
    + (IconButton.make ~label:"Edit" ~children:[ Icon.make ~name:"edit" () ] ()) + (IconButton.make ~label:"Copy" ~children:[ Icon.make ~name:"copy" () ] ()) + (IconButton.make ~label:"Delete" ~children:[ Icon.make ~name:"trash" () ] ()) + (IconButton.make ~label:"More options" ~variant:`solid + ~children:[ Icon.make ~name:"more-horizontal" () ] ()) +
    + +let input_otp_example () = + let code = Signal.make "" in + InputOtp.make ~value:code () + +let link_example () = +
    +

    + ("Read our ") + (Link_.make ~href:"#" ~children:[ txt "getting-started guide" ] ()) + (" to begin.") +

    +
    + (Link_.make ~href:"#" ~variant:`muted ~children:[ txt "Docs" ] ()) + (Link_.make ~href:"#" ~variant:`muted ~children:[ txt "Pricing" ] ()) + (Link_.make ~href:"#" ~new_tab:true ~extra_class:"inline-flex items-center gap-1" + ~children:[ txt "Changelog"; Icon.make ~name:"external-link" ~size:`xs () ] ()) +
    +
    + +let radio_group_example () = + let value = Signal.make "express" in + let opts = + [ + ("standard", "Standard", "3\xe2\x80\x935 business days"); + ("express", "Express", "1\xe2\x80\x932 business days"); + ("overnight", "Overnight", "Next business day"); + ] + in + RadioGroup.make ~value ~options:opts ~legend:"Shipping speed" ~extra_class:"max-w-sm" () + +let scroll_area_example () = + let rows = List.init 24 (fun i -> "Row " ^ string_of_int (i + 1)) in + ScrollArea.make ~extra_class:"h-44 w-64 rounded-md border border-neutral-200" + ~children: + [ + View.element + ~attrs:[ View.Attr.className (View.static "divide-y divide-neutral-100 text-sm") ] + "ul" + (List.map + (fun r -> + View.element + ~attrs:[ View.Attr.className (View.static "px-3 py-2 text-neutral-700") ] + "li" [ txt r ]) + rows); + ] + () + +let toggle_example () = + let on = Signal.make true in + Toggle.make ~pressed:on ~children:[ ("B") ] () + +let toggle_group_example () = + let value = Signal.make [ "center" ] in + let format = Signal.make [ "bold" ] in + let opts = [ ("left", "Left"); ("center", "Center"); ("right", "Right") ] in +
    + (ToggleGroup.make ~value ~options:opts ()) + (ToggleGroup.make ~type_:`multiple ~value:format + ~options:[ ("bold", "Bold"); ("italic", "Italic"); ("underline", "Underline") ] ()) +
    + +let aspect_ratio_example () = + let box = "flex h-full items-center justify-center text-sm font-medium text-neutral-500" in +
    +
    + (AspectRatio.make ~ratio:"16/9" ~extra_class:"rounded-lg bg-neutral-200" + ~children:[
    ("16 : 9")
    ] ()) +
    +
    + (AspectRatio.make ~ratio:"1/1" ~extra_class:"rounded-lg bg-neutral-200" + ~children:[
    ("1 : 1")
    ] ()) +
    +
    + +(* ------------------------------------------------------------------ *) +(* components *) +(* ------------------------------------------------------------------ *) + +let alert_example () = +
    + (Alert.make ~variant:`info ~title:"Heads up" ~description:"Your trial ends in 3 days." ()) + (Alert.make ~variant:`success ~title:"Changes saved" ~description:"Your profile has been updated." ()) + (Alert.make ~variant:`warning ~title:"Storage almost full" ~description:"You've used 90% of your quota." ()) + (Alert.make ~variant:`danger ~title:"Payment failed" + ~description:"Update your card to keep your subscription active." ()) +
    + +let tabs_example () = + let value = Signal.make "account" in + let content () = + match Signal.get value with + | "account" -> "Manage your account details and profile information." + | "password" -> "Change your password and configure two-factor authentication." + | _ -> "Invite teammates and manage their roles and access." + in +
    + (Tabs.make ~value ~tabs:[ ("account", "Account"); ("password", "Password"); ("team", "Team") ] ()) +

    (View.dyn_text content)

    +
    + +let accordion_example () = + let value = Signal.make [ "what" ] in + let items = + [ + ("what", "What is a spec?", "A technology-agnostic definition of a UI pattern, described in words."); + ("framework", "Is it tied to a framework?", + "No. Each spec maps onto any stack \xe2\x80\x94 this site happens to use Xote."); + ("contribute", "Can I contribute?", + "Yes. Copy the template, fill every section, and open a pull request."); + ] + in + Accordion.make ~value ~items () + +let collapsible_example () = + let open_ = Signal.make false in + Collapsible.make ~open_ ~label:"Show details" + ~children:[ txt "Secondary content revealed on demand, pushing the layout below it." ] + () + +let dialog_example () = + let open_ = Signal.make false in +
    + (Button.make ~variant:`primary + ~on_click:(fun _ -> Signal.set open_ true) + ~children:[ txt "Edit profile" ] ()) + (Dialog.make ~open_ ~title:"Edit profile" ~description:"Make changes and save when you're done." + ~children: + [ +
    + (Field.make ~label:"Name" ~for_:"dlg-name" + ~children:[ Input.make ~id:"dlg-name" ~value:"Ada Lovelace" () ] ()) +
    ; +
    + (Button.make ~variant:`secondary + ~on_click:(fun _ -> Signal.set open_ false) + ~children:[ txt "Cancel" ] ()) + (Button.make ~variant:`primary + ~on_click:(fun _ -> Signal.set open_ false) + ~children:[ txt "Save" ] ()) +
    ; + ] + ()) +
    + +let tooltip_example () = +
    + (Tooltip.make ~content:"Add to library" + ~children:[ Button.make ~variant:`secondary ~children:[ txt "Hover me" ] () ] ()) +
    + +let field_example () = + let value = Signal.make "nope" in + let invalid () = not (String.contains (Signal.get value) '@') in + let cls () = + Ui.input_base ^ (if invalid () then " border-neutral-900 ring-1 ring-neutral-900" else "") + in +
    + (Field.make ~label:"Work email" ~for_:"fld-email" + ~children: + [ + View.element + ~attrs: + [ + View.Attr.id (View.static "fld-email"); + View.Attr.value (View.static "nope"); + View.Attr.class_reactive cls; + ] + ~events:[ View.On.input (fun e -> Signal.set value (Ui.input_value e)) ] + "input" []; + View.show + ~fallback:(

    ("We'll only use this to contact you.")

    ) + (fun () -> invalid ()) + (

    ("Enter a valid email address.")

    ); + ] + ()) +
    + +let select_example () = + let value = Signal.make "Medium" in + Select.make ~value ~options:[ "Small"; "Medium"; "Large"; "Extra large" ] () + +(* ------------------------------------------------------------------ *) +(* blocks *) +(* ------------------------------------------------------------------ *) + +let page_header_example () = +
    + (PageHeader.make ~title:"Deployments" + ~description:"Everything your team shipped in the last 30 days." + ~breadcrumb:[ ("Acme", "#"); ("Production", "#"); ("Deployments", "") ] + ~children: + [ + Button.make ~variant:`secondary ~size:`sm ~children:[ txt "Export" ] (); + Button.make ~variant:`primary ~size:`sm ~children:[ txt "New deploy" ] (); + ] + ()) +
    + +let stat_grid_example () = + let loading = Signal.make false in + let stats = + [ + ("Revenue", "$48.2k", "+12% vs. last month", `up); + ("Active users", "1,203", "+3% vs. last month", `up); + ("Signups", "312", "\xe2\x88\x925% vs. last month", `down); + ("Uptime", "99.98%", "flat vs. last month", `flat); + ] + in +
    + (View.show + ~fallback:(StatGrid.make ~heading:"This month" ~stats ()) + (fun () -> Signal.get loading) + (StatGrid.make ~heading:"This month" ~stats ~loading:true ())) + (Button.make ~variant:`secondary ~size:`sm + ~on_click:(fun _ -> + Signal.set loading true; + Ui.set_timeout (fun () -> Signal.set loading false) 1500) + ~children:[ txt "Simulate loading" ] ()) +
    + +let logo_cloud_example () = +
    + (LogoCloud.make ~heading:"Trusted by teams at" + ~logos:[ "Acme"; "Northwind"; "Globex"; "Initech"; "Umbrella"; "Aperture" ] ()) +
    + +let steps_example () = + let steps = + [ + ("Connect your repo", "Authorize once; we pick up every branch automatically."); + ("Push a commit", "Each push builds, tests, and previews in isolation."); + ("Ship it", "Promote the preview to production with one click."); + ] + in +
    (Steps.make ~heading:"How it works" ~steps ())
    + +let contact_section_example () = +
    + (ContactSection.make ~heading:"Talk to us" + ~description:"Questions about specs, tokens, or the agent skill? We reply within one business day." + ~details: + [ + ("mail", "hello@acme.dev", "mailto:hello@acme.dev"); + ("github", "acme/support", "https://github.com"); + ] + ()) +
    + +let newsletter_example () = +
    + (Newsletter.make ~heading:"Get the monthly digest" + ~description:"One email a month: new specs, patterns, and releases. No spam." + ~consent:"By subscribing you agree to the privacy policy. Unsubscribe anytime." ()) +
    + +let announcement_bar_example () = +
    + (AnnouncementBar.make ~variant:`accent ~message:"v2 ships May 4 \xe2\x80\x94 everything gets faster." + ~action_label:"See what's new" ()) + (AnnouncementBar.make ~variant:`neutral ~message:"We've updated our terms of service." + ~action_label:"Read the changes" ()) + (AnnouncementBar.make ~variant:`warning + ~message:"Scheduled maintenance Sunday 02:00\xe2\x80\x9304:00 UTC." ()) +
    + +(* ------------------------------------------------------------------ *) +(* registry + mount entry (the JS surface consumed by the website) *) +(* ------------------------------------------------------------------ *) + +let example_for = function + | "aspect-ratio" -> aspect_ratio_example () + | "avatar" -> avatar_example () + | "badge" -> badge_example () + | "button" -> button_example () + | "checkbox" -> checkbox_example () + | "icon" -> icon_example () + | "icon-button" -> icon_button_example () + | "input" -> input_example () + | "input-otp" -> input_otp_example () + | "kbd" -> kbd_example () + | "link" -> link_example () + | "progress" -> progress_example () + | "radio-group" -> radio_group_example () + | "scroll-area" -> scroll_area_example () + | "separator" -> separator_example () + | "skeleton" -> skeleton_example () + | "slider" -> slider_example () + | "spinner" -> spinner_example () + | "switch" -> switch_example () + | "textarea" -> textarea_example () + | "toggle" -> toggle_example () + | "toggle-group" -> toggle_group_example () + | "accordion" -> accordion_example () + | "alert" -> alert_example () + | "collapsible" -> collapsible_example () + | "dialog" -> dialog_example () + | "field" -> field_example () + | "select" -> select_example () + | "tabs" -> tabs_example () + | "tooltip" -> tooltip_example () + | "announcement-bar" -> announcement_bar_example () + | "contact-section" -> contact_section_example () + | "logo-cloud" -> logo_cloud_example () + | "newsletter" -> newsletter_example () + | "page-header" -> page_header_example () + | "stat-grid" -> stat_grid_example () + | "steps" -> steps_example () + | _ -> View.empty + +(* Mount the reativa example for [spec_id] into the element with id + [container_id]. The container is cleared first so re-selecting the tab + re-mounts cleanly instead of stacking copies. Called from ReScript via the + esbuild-bundled ES module (see website/src/ReativaExamples.res). *) +let mount_example spec_id container_id = + match Dom.by_id container_id with + | None -> () + | Some el -> + Dom.set_text_content el ""; + View.mount el (example_for spec_id) + +(* The spec ids that have a reativa implementation, exposed to the website so it + knows which specs get a "Reativa" tab. *) +let example_ids = + [| + "aspect-ratio"; "avatar"; "badge"; "button"; "checkbox"; "icon"; "icon-button"; "input"; + "input-otp"; "kbd"; "link"; "progress"; "radio-group"; "scroll-area"; "separator"; "skeleton"; + "slider"; "spinner"; "switch"; "textarea"; "toggle"; "toggle-group"; "accordion"; "alert"; + "collapsible"; "dialog"; "field"; "select"; "tabs"; "tooltip"; "announcement-bar"; + "contact-section"; "logo-cloud"; "newsletter"; "page-header"; "stat-grid"; "steps"; + |] + +(* Distinguishes the real compiled bundle from the checked-in placeholder. *) +let built = true \ No newline at end of file diff --git a/packages/reativa/src/ScrollArea.mlx b/packages/reativa/src/ScrollArea.mlx new file mode 100644 index 0000000..c8dce5b --- /dev/null +++ b/packages/reativa/src/ScrollArea.mlx @@ -0,0 +1,16 @@ +[@@@warning "-a"] + +(* ScrollArea — a container that scrolls its overflowing content. Implements the + `scroll-area` spec. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(orientation : Contracts.ScrollArea.orientation = `vertical) ?(extra_class = "") ~children () = + let overflow = + match orientation with + | `vertical -> "overflow-y-auto" + | `horizontal -> "overflow-x-auto" + | `both -> "overflow-auto" + in +
    (View.fragment children)
    \ No newline at end of file diff --git a/packages/reativa/src/Select.mlx b/packages/reativa/src/Select.mlx new file mode 100644 index 0000000..bc2d99c --- /dev/null +++ b/packages/reativa/src/Select.mlx @@ -0,0 +1,63 @@ +[@@@warning "-a"] + +(* Select — a control that opens a list for choosing one option. Controlled via + the [value] signal; [disabled] blocks interaction (both contract props). The + open state is internal. Dismisses on outside click (Backdrop). *) + +open Reativa +open Reativa.View.Mlx + +let make ?(disabled = false) ~value ~options () = + let open_ = Signal.make false in + let label () = Signal.get value in + let option_row o = + let mark () = if Signal.get value = o then "\xe2\x9c\x93" else "" in + View.element ~attrs:[] "li" + [ + View.element + ~attrs: + [ + View.Attr.make "role" (View.static "option"); + View.Attr.className + (View.static + "flex w-full items-center justify-between px-3 py-1.5 text-left text-sm text-neutral-700 hover:bg-neutral-100"); + ] + ~events:[ View.On.click (fun _ -> Signal.set value o; Signal.set open_ false) ] + "button" + [ + View.text (View.static o); + View.element + ~attrs:[ View.Attr.className (View.static "text-neutral-900") ] + "span" + [ View.dyn_text mark ]; + ]; + ] + in +
    + (View.element + ~attrs: + [ + View.Attr.disabled (fun () -> disabled); + View.Attr.className + (View.static (Ui.input_base ^ " flex items-center justify-between disabled:opacity-40")); + ] + ~events:[ View.On.click (fun _ -> Signal.update open_ (fun v -> not v)) ] + "button" + [ View.dyn_text label; ("\xe2\x8c\x84") ]) + (View.show + (fun () -> Signal.get open_) + (View.fragment + [ + Backdrop.make ~on_close:(fun () -> Signal.set open_ false) (); + View.element + ~attrs: + [ + View.Attr.make "role" (View.static "listbox"); + View.Attr.className + (View.static + "absolute z-20 mt-1 w-full rounded-md border border-neutral-200 bg-surface py-1 shadow-lg"); + ] + "ul" + (List.map option_row options); + ])) +
    \ No newline at end of file diff --git a/packages/reativa/src/Separator.mlx b/packages/reativa/src/Separator.mlx new file mode 100644 index 0000000..d7635aa --- /dev/null +++ b/packages/reativa/src/Separator.mlx @@ -0,0 +1,21 @@ +[@@@warning "-a"] + +(* Separator — a hairline divider, horizontal or vertical. Reused by menus, + cards, and toolbars. [role="separator"] is not one of the attributes the mlx + element helper exposes, so the root is built with [View.element ~attrs]. *) + +open Reativa + +let make ?(orientation : Contracts.Separator.orientation = `horizontal) ?(extra_class = "") () = + let base = + match orientation with + | `horizontal -> "h-px w-full bg-neutral-200" + | `vertical -> "h-4 w-px bg-neutral-200" + in + View.element + ~attrs: + [ + View.Attr.className (View.static (Ui.cx base extra_class)); + View.Attr.make "role" (View.static "separator"); + ] + "div" [] \ No newline at end of file diff --git a/packages/reativa/src/Skeleton.mlx b/packages/reativa/src/Skeleton.mlx new file mode 100644 index 0000000..2e96f21 --- /dev/null +++ b/packages/reativa/src/Skeleton.mlx @@ -0,0 +1,16 @@ +[@@@warning "-a"] + +(* Skeleton — a pulsing placeholder block that mirrors content while it loads. + Compose several to sketch a layout. Implements the `skeleton` spec. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(shape : Contracts.Skeleton.shape = `text) ?(extra_class = "") () = + let shape_cls = + match shape with + | `text -> "h-3 rounded" + | `circle -> "rounded-full" + | `rect -> "rounded-lg" + in +
    \ No newline at end of file diff --git a/packages/reativa/src/Slider.mlx b/packages/reativa/src/Slider.mlx new file mode 100644 index 0000000..7d991eb --- /dev/null +++ b/packages/reativa/src/Slider.mlx @@ -0,0 +1,26 @@ +[@@@warning "-a"] + +(* Slider — a controlled range input bound to an int signal. Implements the + `slider` spec. *) + +open Reativa + +let make ?(min = 0) ?(max = 100) ?(step = 1) ?(disabled = false) ?on_change ~value () = + let handle ev = + let n = match int_of_string_opt (Ui.input_value ev) with Some n -> n | None -> 0 in + Signal.set value n; + match on_change with Some f -> f ev | None -> () + in + View.element + ~attrs: + [ + View.Attr.type_ (View.static "range"); + View.Attr.make "min" (View.static (string_of_int min)); + View.Attr.make "max" (View.static (string_of_int max)); + View.Attr.make "step" (View.static (string_of_int step)); + View.Attr.value (View.dynamic (fun () -> string_of_int (Signal.get value))); + View.Attr.disabled (fun () -> disabled); + View.Attr.className (View.static "w-full accent-neutral-900 disabled:opacity-40"); + ] + ~events:[ View.On.input handle ] + "input" [] \ No newline at end of file diff --git a/packages/reativa/src/Spinner.mlx b/packages/reativa/src/Spinner.mlx new file mode 100644 index 0000000..60d4900 --- /dev/null +++ b/packages/reativa/src/Spinner.mlx @@ -0,0 +1,16 @@ +[@@@warning "-a"] + +(* Spinner — an indeterminate loading indicator. Reused inside Button (loading) + and elsewhere. [tone] picks a spinner that reads on a light surface ([`ink]) + or on an accent/dark one ([`on_accent]). *) + +open Reativa +open Reativa.View.Mlx + +let make ?(size = "size-4") ?(tone = `ink) () = + let colors = + match tone with + | `ink -> "border-neutral-300 border-t-neutral-900" + | `on_accent -> "border-white/40 border-t-white" + in + \ No newline at end of file diff --git a/packages/reativa/src/StatGrid.mlx b/packages/reativa/src/StatGrid.mlx new file mode 100644 index 0000000..b0c4cbb --- /dev/null +++ b/packages/reativa/src/StatGrid.mlx @@ -0,0 +1,66 @@ +[@@@warning "-a"] + +(* Stat Grid — the metric-summary band a dashboard opens with. Each entry is + (label, value, delta, trend); [trend] reuses the stat contract's enum + (Contracts.Stat.trend). [loading] renders skeleton tiles in the same grid, so + the layout is reserved and nothing shifts when values arrive. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(heading = "") ?(loading = false) ~stats () = + let loading_tile _ = + View.element + ~attrs: + [ + View.Attr.className (View.static (Ui.card ^ " p-4")); + View.Attr.make "aria-hidden" (View.static "true"); + ] + "li" + [ + Skeleton.make ~shape:`text ~extra_class:"w-20" (); + Skeleton.make ~shape:`text ~extra_class:"mt-3 h-7 w-28" (); + Skeleton.make ~shape:`text ~extra_class:"mt-3 w-16" (); + ] + in + let stat_tile (label, value, delta, trend) = + (* Direction is conveyed by icon + text, not color alone. *) + let trend_icon, trend_cls = + match trend with + | `up -> ("arrow-up", "text-status-success") + | `down -> ("arrow-down", "text-status-danger") + | `flat -> ("minus", "text-muted") + in + View.element + ~attrs:[ View.Attr.className (View.static (Ui.card ^ " p-4")) ] + "li" + [ +

    (label)

    ; +

    (value)

    ; + (if delta = "" then View.empty + else + View.element + ~attrs: + [ + View.Attr.className + (View.static ("mt-1 flex items-center gap-1 text-xs font-medium " ^ trend_cls)); + ] + "p" + [ Icon.make ~name:trend_icon ~size:`xs (); View.text (View.static delta) ]); + ] + in + let tiles = if loading then List.map loading_tile stats else List.map stat_tile stats in + View.element + ~attrs:[ View.Attr.className (View.static "w-full") ] + "section" + [ + (if heading = "" then View.empty + else

    (heading)

    ); + View.element + ~attrs: + [ + View.Attr.className + (View.static "grid w-full grid-cols-1 gap-4 sm:grid-cols-2 lg:grid-cols-4"); + ] + "ul" tiles; + ] \ No newline at end of file diff --git a/packages/reativa/src/Steps.mlx b/packages/reativa/src/Steps.mlx new file mode 100644 index 0000000..0233004 --- /dev/null +++ b/packages/reativa/src/Steps.mlx @@ -0,0 +1,57 @@ +[@@@warning "-a"] + +(* Steps — an ordered "how it works" sequence: numbered markers, a short title + and one line of description per step, tied together by connectors. The + [orientation] type comes from the spec's `## API` contract (Contracts.ml). + Order is carried by the list semantics — markers and connectors are + decorative. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(orientation : Contracts.Steps.orientation = `horizontal) ?(heading = "") ~steps () = + let n = List.length steps in + let numbered = + List.mapi (fun i (title, description) -> (string_of_int (i + 1), title, description, i = n - 1)) steps + in + let list_cls = + match orientation with + | `horizontal -> "flex flex-col gap-8 md:flex-row md:gap-6" + | `vertical -> "flex flex-col gap-8" + in + let step_item (number, title, description, is_last) = +
  • + (View.element + ~attrs: + [ + View.Attr.className (View.static "flex flex-col items-center"); + View.Attr.make "aria-hidden" (View.static "true"); + ] + "div" + [ + + (number) + ; + (* The vertical connector between markers; the last step ends the path. *) + (if (not is_last) && orientation = `vertical then + + else View.empty); + ]) +
    +

    (title)

    +

    (description)

    +
    +
    • + in + View.element + ~attrs:[ View.Attr.className (View.static "w-full") ] + "section" + [ + (if heading = "" then View.empty + else +

    (heading)

    ); + View.element + ~attrs:[ View.Attr.className (View.static list_cls) ] + "ol" + (List.map step_item numbered); + ] \ No newline at end of file diff --git a/packages/reativa/src/Switch.mlx b/packages/reativa/src/Switch.mlx new file mode 100644 index 0000000..d9479fd --- /dev/null +++ b/packages/reativa/src/Switch.mlx @@ -0,0 +1,41 @@ +[@@@warning "-a"] + +(* Switch — a controlled on/off toggle bound to a signal. Implements the `switch` + spec: [checked] drives the visual state and the aria-checked announcement, + [disabled] blocks interaction. [role]/[aria-checked] aren't attributes the mlx + element helper exposes, so the control is built with [View.element]. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(label = "") ?(disabled = false) ~checked () = + let track () = + "relative inline-flex h-6 w-11 items-center rounded-full transition-colors " + ^ (if Signal.get checked then "bg-action" else "bg-neutral-300") + ^ if disabled then " opacity-40" else "" + in + let knob () = + "inline-block size-5 transform rounded-full bg-surface shadow transition-transform " + ^ if Signal.get checked then "translate-x-5" else "translate-x-0.5" + in + let aria_checked () = if Signal.get checked then "true" else "false" in + let knob_node = View.element ~attrs:[ View.Attr.class_reactive knob ] "span" [] in + let control = + View.element + ~attrs: + [ + View.Attr.type_ (View.static "button"); + View.Attr.make "role" (View.static "switch"); + View.Attr.make "aria-checked" (View.dynamic aria_checked); + View.Attr.disabled (fun () -> disabled); + View.Attr.class_reactive track; + ] + ~events: + [ View.On.click (fun _ -> if disabled then () else Signal.update checked (fun v -> not v)) ] + "button" [ knob_node ] + in + let label_cls = if disabled then "flex items-center gap-3 cursor-not-allowed" else "flex items-center gap-3" in + \ No newline at end of file diff --git a/packages/reativa/src/Tabs.mlx b/packages/reativa/src/Tabs.mlx new file mode 100644 index 0000000..576d0db --- /dev/null +++ b/packages/reativa/src/Tabs.mlx @@ -0,0 +1,34 @@ +[@@@warning "-a"] + +(* Tabs — a tablist whose selected tab drives a panel. Controlled via a [value] + signal (the active tab id); [orientation] comes from the contract type. The + panel is rendered by the caller from the same signal. [role] isn't a mlx + element attribute, so each tab uses [View.element]. *) + +open Reativa + +let make ?(orientation : Contracts.Tabs.orientation = `horizontal) ~value ~tabs () = + let list_cls = + match orientation with + | `horizontal -> "flex gap-1 border-b border-neutral-200" + | `vertical -> "flex flex-col gap-1 border-r border-neutral-200" + in + let render (id, label) = + let cls () = + let active = Signal.get value = id in + "-mb-px border-b-2 px-4 py-2 text-sm font-medium transition-colors " + ^ + if active then "border-neutral-900 text-neutral-900" + else "border-transparent text-neutral-500 hover:text-neutral-800" + in + View.element + ~attrs:[ View.Attr.make "role" (View.static "tab"); View.Attr.class_reactive cls ] + ~events:[ View.On.click (fun _ -> Signal.set value id) ] + "button" + [ View.text (View.static label) ] + in + View.element + ~attrs: + [ View.Attr.make "role" (View.static "tablist"); View.Attr.className (View.static list_cls) ] + "div" + (List.map render tabs) \ No newline at end of file diff --git a/packages/reativa/src/Textarea.mlx b/packages/reativa/src/Textarea.mlx new file mode 100644 index 0000000..4fc4625 --- /dev/null +++ b/packages/reativa/src/Textarea.mlx @@ -0,0 +1,24 @@ +[@@@warning "-a"] + +(* Textarea — a multi-line text field. Left visually uncontrolled so typing + stays smooth; writes its text to the given signal on input. Implements the + `textarea` spec. *) + +open Reativa + +let make ?(placeholder = "") ?(rows = 3) ?(required = false) ?id ?(extra_class = "") ?on_input + ~value () = + let handle ev = + Signal.set value (Ui.input_value ev); + match on_input with Some f -> f ev | None -> () + in + let attrs = + [ + View.Attr.make "rows" (View.static (string_of_int rows)); + View.Attr.placeholder (View.static placeholder); + View.Attr.className (View.static (Ui.cx (Ui.input_base ^ " resize-y") extra_class)); + View.Attr.toggle "required" (fun () -> required); + ] + in + let attrs = match id with Some i -> View.Attr.id (View.static i) :: attrs | None -> attrs in + View.element ~attrs ~events:[ View.On.input handle ] "textarea" [] \ No newline at end of file diff --git a/packages/reativa/src/Toggle.mlx b/packages/reativa/src/Toggle.mlx new file mode 100644 index 0000000..21f6570 --- /dev/null +++ b/packages/reativa/src/Toggle.mlx @@ -0,0 +1,21 @@ +[@@@warning "-a"] + +(* Toggle — a two-state button bound to a signal. Implements the `toggle` spec. *) + +open Reativa +open Reativa.View.Mlx + +let make ?(disabled = false) ~pressed ~children () = + let cls () = + "inline-flex size-10 items-center justify-center rounded-md text-sm font-semibold transition-colors " + ^ + if Signal.get pressed then "bg-neutral-900 text-neutral-0" + else "border border-neutral-300 bg-surface text-neutral-700 hover:bg-neutral-100" + in + \ No newline at end of file diff --git a/packages/reativa/src/ToggleGroup.mlx b/packages/reativa/src/ToggleGroup.mlx new file mode 100644 index 0000000..e3eca50 --- /dev/null +++ b/packages/reativa/src/ToggleGroup.mlx @@ -0,0 +1,46 @@ +[@@@warning "-a"] + +(* ToggleGroup — a segmented control bound to a signal. Each option is an + (id, label) pair. Implements the `toggle-group` spec: [type_] picks between + single select (segmented control) and multiple select (independent toggles), + so the bound value is a list of selected ids — one entry in single mode. + [aria-pressed] isn't a mlx element attribute, so each toggle uses + [View.element]. *) + +open Reativa + +let make ?(type_ : Contracts.ToggleGroup.type_ = `single) ?(disabled = false) ~value ~options () = + let toggle id = + match type_ with + | `single -> Signal.set value [ id ] + | `multiple -> + Signal.update value (fun v -> + if List.mem id v then List.filter (fun x -> x <> id) v else v @ [ id ]) + in + let render (id, label) = + let cls () = + "border-l border-neutral-300 px-4 py-2 text-sm transition-colors first:border-l-0 " + ^ + if List.mem id (Signal.get value) then "bg-action text-on-action" + else "bg-surface text-neutral-700 hover:bg-neutral-100" + in + let pressed () = if List.mem id (Signal.get value) then "true" else "false" in + View.element + ~attrs: + [ + View.Attr.type_ (View.static "button"); + View.Attr.make "aria-pressed" (View.dynamic pressed); + View.Attr.class_reactive cls; + ] + ~events:[ View.On.click (fun _ -> toggle id) ] + "button" + [ View.text (View.static label) ] + in + let wrap_cls = + "inline-flex overflow-hidden rounded-md border border-neutral-300" + ^ if disabled then " pointer-events-none opacity-50" else "" + in + View.element + ~attrs:[ View.Attr.make "role" (View.static "group"); View.Attr.className (View.static wrap_cls) ] + "div" + (List.map render options) \ No newline at end of file diff --git a/packages/reativa/src/Tooltip.mlx b/packages/reativa/src/Tooltip.mlx new file mode 100644 index 0000000..4ccaead --- /dev/null +++ b/packages/reativa/src/Tooltip.mlx @@ -0,0 +1,38 @@ +[@@@warning "-a"] + +(* Tooltip — a brief label revealed on hover/focus of its trigger. [content] is + the contract prop; the trigger is passed as children. Anchored above the + trigger. The hover/focus events aren't attributes the mlx element helper + exposes, so the wrapper is built with [View.element ~events] using bubbling + [mouseenter]/[mouseleave]/[focusin]/[focusout]. *) + +open Reativa + +let make ~content ~children () = + let open_ = Signal.make false in + View.element + ~attrs:[ View.Attr.className (View.static "relative inline-block") ] + ~events: + [ + View.On.on "mouseenter" (fun _ -> Signal.set open_ true); + View.On.on "mouseleave" (fun _ -> Signal.set open_ false); + View.On.on "focusin" (fun _ -> Signal.set open_ true); + View.On.on "focusout" (fun _ -> Signal.set open_ false); + ] + "span" + [ + View.fragment children; + View.show + (fun () -> Signal.get open_) + (View.element + ~attrs: + [ + View.Attr.make "role" (View.static "tooltip"); + View.Attr.className + (View.static + "absolute -top-9 left-1/2 -translate-x-1/2 whitespace-nowrap rounded-md \ + bg-neutral-900 px-2 py-1 text-xs text-neutral-0"); + ] + "span" + [ View.text (View.static content) ]); + ] \ No newline at end of file diff --git a/packages/reativa/src/Ui.ml b/packages/reativa/src/Ui.ml new file mode 100644 index 0000000..8b68906 --- /dev/null +++ b/packages/reativa/src/Ui.ml @@ -0,0 +1,78 @@ +[@@@warning "-a"] + +(* Shared monochrome design tokens (Tailwind class strings) and small DOM + helpers used across the reativa example implementations — the OCaml + counterpart of @xpecs/xote's [Ui] module. + + The class strings are the same token-driven Tailwind utilities the Xote + components use (bg-action, text-on-action, border-status-*, …) so editing a + token re-themes both implementations identically. *) + +open Reativa + +(* ----- DOM helpers (Melange FFI) ----- *) + +(* window.setTimeout — used to defer property writes to freshly-rendered nodes + (indeterminate, innerHTML) a tick, so the node exists when we look it up. *) +external set_timeout : (unit -> unit) -> int -> unit = "setTimeout" + +(* Read the [checked] property off an event's target (checkbox / radio). *) +external checked_of : Dom.t -> bool = "checked" [@@mel.get] +let checked (ev : Dom.event) : bool = checked_of (Dom.target ev) + +(* Read the current value of an input/textarea/select from a DOM event. *) +let input_value (ev : Dom.event) : string = Dom.target_value ev + +(* [indeterminate] has no HTML attribute — it is property-only, so it can't be + expressed as a JSX/attribute and is set on the node after render. *) +external set_indeterminate : Dom.t -> bool -> unit = "indeterminate" [@@mel.set] + +let set_indeterminate_by_id id v = + set_timeout + (fun () -> match Dom.by_id id with Some el -> set_indeterminate el v | None -> ()) + 0 + +(* Inline SVG has to be injected as markup: reativa's [Dom.create_element] uses + [document.createElement] (HTML namespace), so an [] built through the + View layer would not render. Icons set their markup via [innerHTML] on a host + [] instead, which the browser parses in the SVG namespace and which + still inherits [currentColor] from the surrounding text. *) +external set_inner_html : Dom.t -> string -> unit = "innerHTML" [@@mel.set] + +let set_inner_html_by_id id html = + set_timeout + (fun () -> match Dom.by_id id with Some el -> set_inner_html el html | None -> ()) + 0 + +(* preventDefault, for form submit handlers. *) +let prevent_default = Dom.prevent_default + +(* ----- Buttons ----- *) +(* Composed from the semantic color roles (bg-action, text-on-action, + bg-status-danger, …) so editing those tokens re-themes every control. Split + into layout core, size, and color so the Button element composes variant × + size. *) +let btn_core = + "inline-flex items-center justify-center rounded-lg font-medium transition-colors \ + focus-visible:outline-none focus-visible:ring-2 focus-visible:ring-action \ + focus-visible:ring-offset-2 focus-visible:ring-offset-surface \ + disabled:opacity-40 disabled:pointer-events-none" +let btn_lg = "gap-2 px-5 py-2.5 text-base" +let btn_md = "gap-2 px-4 py-2 text-sm" +let btn_sm = "gap-1 px-2.5 py-1 text-xs" +let btn_primary_colors = "bg-action text-on-action hover:bg-action-hover" +let btn_secondary_colors = "border border-border bg-surface text-ink hover:bg-action-subtle" +let btn_ghost_colors = "text-ink hover:bg-action-subtle" +let btn_destructive_colors = "bg-status-danger text-on-action hover:opacity-90" + +(* ----- Surfaces ----- *) +let card = "rounded-2xl border border-border bg-surface shadow-sm" +let input_base = + "w-full rounded-lg border border-border bg-surface px-3 py-2 text-sm text-ink \ + placeholder:text-muted focus-visible:outline-none focus-visible:ring-2 \ + focus-visible:ring-action focus-visible:ring-offset-0" +let label = "block text-sm font-medium text-ink" +let muted = "text-muted" + +(* Append an extra class string only when non-empty (mirrors the Xote helper). *) +let cx base extra = if extra = "" then base else base ^ " " ^ extra \ No newline at end of file diff --git a/website/README.md b/website/README.md index 534d3c4..7bc95c7 100644 --- a/website/README.md +++ b/website/README.md @@ -58,18 +58,21 @@ Each spec's example is a small self-contained Xote component in `Examples.res`; `Examples.get(id)` maps a spec `id` to its rendered node. Specs without an example fall back to a graceful placeholder. -## Reativa tab (OCaml + Melange) — proof of concept - -A few specs (`button`, `badge`, `alert`, `cta-section`) are **also** implemented -in OCaml with [reativa](https://github.com/brnrdog/reativa) — the signal-based -sibling of Xote — under [`reativa/`](reativa). The example block gains a -**Reativa** tab next to **Preview**, rendering the same spec from the same -design tokens, so the two implementations sit side by side. - -That build is a self-contained Melange workspace, kept **separate** from this -ReScript/Vite build (it needs opam + melange, the website doesn't). A checked-in -placeholder bundle keeps the site compiling until you run `npm run reativa`; see -[`reativa/README.md`](reativa/README.md). +## Xote / Reativa implementations + +Every element, component, and block that `@xpecs/xote` implements is **also** +implemented in OCaml with [reativa](https://github.com/brnrdog/reativa) — the +signal-based sibling of Xote — in the +[`@xpecs/reativa`](../packages/reativa) package. The example block has two tab +strips: one picks the **view** (Preview / Playground / Code) and one picks the +**implementation** rendered in the preview (**Xote** or **Reativa**), so the two +render the same spec from the same design tokens, side by side. + +The reativa build is a self-contained Melange workspace, kept **separate** from +this ReScript/Vite build (it needs opam + melange, the website doesn't). +`npm run reativa` builds `@xpecs/reativa` and copies its bundle to +`src/reativa.bundle.js`; a checked-in placeholder keeps the site compiling until +then. See [`packages/reativa/README.md`](../packages/reativa/README.md). ## Develop diff --git a/website/reativa/.gitignore b/website/reativa/.gitignore deleted file mode 100644 index b474270..0000000 --- a/website/reativa/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -# reativa clone + Melange build output, produced by `npm run reativa`. -.build/ -_build/ diff --git a/website/reativa/README.md b/website/reativa/README.md deleted file mode 100644 index 2481df3..0000000 --- a/website/reativa/README.md +++ /dev/null @@ -1,73 +0,0 @@ -# Reativa examples (OCaml + Melange) - -A small proof-of-concept: a handful of Xpecs specs implemented in **OCaml** -with [**reativa**](https://github.com/brnrdog/reativa) — the fine-grained, -signal-based UI library (the OCaml sibling of [Xote](https://xote.dev)) — as a -counterpart to the ReScript + Xote implementations in -[`../src/Examples.res`](../src/Examples.res). - -The website renders both from the same design tokens: the **Preview** tab shows -the Xote version, the **Reativa** tab shows the version compiled from here. - -## What's implemented - -| Spec | Layer | Source | -| ---- | ----- | ------ | -| `button` | element | `Button` module in [`xpecs_reativa.mlx`](xpecs_reativa.mlx) | -| `badge` | element | `Badge` module | -| `alert` | component | `Alert` module (dismissible — demonstrates signals) | -| `cta-section` | block | `cta_example` (reactive email input) | - -Everything is written in `.mlx` (JSX-for-OCaml, transformed by `mlx-pp`) over -`Reativa.View`. There is no virtual DOM: `View.mount` builds real DOM nodes -once and only the reactive regions update in place. - -## How it plugs into the (ReScript/Vite) website - -The Melange build is deliberately separate from the ReScript/Vite build, so the -website keeps compiling without an OCaml toolchain. -[`../scripts/build-reativa.mjs`](../scripts/build-reativa.mjs) (run by -`npm run reativa`) does the work: - -1. **Clones reativa** (pinned to a commit) into `.build/reativa/`. reativa's core - library has no `public_name`, so it is a *private* dune library that can't be - consumed as an installed opam package — its own demo builds only because it - lives inside the reativa dune project. So we do the same: it copies - [`dune`](dune) + [`xpecs_reativa.mlx`](xpecs_reativa.mlx) into a subdirectory - of the clone, where the private `reativa` library and the `reativa.mlx_ppx` - ppx are in scope. -2. `dune build @melange` compiles them to ES modules. -3. `esbuild` bundles the emitted entry into - [`../src/reativa.bundle.js`](../src/reativa.bundle.js) — a single ES module - exporting `mount_example(specId, containerId)`, `example_ids`, and `built`. -4. The website ([`../src/ReativaExamples.res`](../src/ReativaExamples.res)) - imports that bundle and, when the **Reativa** tab is opened, imperatively - mounts the example into a container `
    ` that Xote renders. - -A checked-in **placeholder** bundle (`built = false`) stands in until you build, -so the site compiles out of the box and the Reativa tab shows a build hint. - -## Building - -Requires the OCaml toolchain (an opam switch on OCaml **5.1+**, since reativa -needs `melange >= 3`). One-time setup: - -```bash -opam switch create . 5.2.1 # or reuse an existing 5.1+ switch -opam install dune melange mlx -``` - -Then, from the `website/` directory: - -```bash -npm run reativa # clone reativa → dune build @melange → esbuild bundle -npm run dev # start the site; open any of the specs above → "Reativa" -``` - -`npm run reativa` overwrites `../src/reativa.bundle.js` with the real compiled -output (`built = true`). Re-run it after editing `xpecs_reativa.mlx`. To move to -a newer reativa, bump `REATIVA_REF` in `build-reativa.mjs`. - -> Note: `npm run reativa` is intentionally **not** part of `npm run build`/`dev` -> (it needs opam/melange, which the rest of the website build does not) — but CI -> runs it, so PRs compile the examples and Pages ships the real bundle. diff --git a/website/reativa/dune b/website/reativa/dune deleted file mode 100644 index 4bd6eee..0000000 --- a/website/reativa/dune +++ /dev/null @@ -1,11 +0,0 @@ -; Compiles xpecs_reativa.mlx to JavaScript ES modules under -; website/reativa/_build/default/output/. The emitted entry -; (output/xpecs_reativa.js) is bundled for the browser with esbuild by the -; `npm run reativa` script; see README.md. -(melange.emit - (target output) - (modules xpecs_reativa) - (libraries reativa) - (preprocess - (pps reativa.mlx_ppx melange.ppx)) - (module_systems es6)) diff --git a/website/reativa/xpecs_reativa.mlx b/website/reativa/xpecs_reativa.mlx deleted file mode 100644 index 273b5a2..0000000 --- a/website/reativa/xpecs_reativa.mlx +++ /dev/null @@ -1,203 +0,0 @@ -(* Reativa (OCaml + Melange) implementations of a handful of Xpecs specs. - - This is the ReasonML/OCaml counterpart to the ReScript + Xote examples in - [website/src/Examples.res]. The two render the *same* specs, side by side, - from the same design tokens — the website shows the Xote version under the - "Preview" tab and this Melange version under the "Reativa" tab. - - Everything below is written in .mlx (JSX-for-OCaml, transformed by mlx-pp) - over [Reativa.View]. There is no virtual DOM: [View.mount] builds real DOM - nodes once and only reactive regions (driven by signals) update in place. - - Classes are the shared, token-driven Tailwind utilities (bg-action, - text-on-action, border-status-*, …) so a re-theme cascades through these - exactly like it does through the Xote components. *) - -open Reativa -open Reativa.View.Mlx - -(* ------------------------------------------------------------------ *) -(* element: button *) -(* ------------------------------------------------------------------ *) - -module Button = struct - type variant = - | Primary - | Secondary - | Ghost - | Destructive - - (* Layout core shared by every variant (mirrors Ui.btnCore / Ui.btnMd). *) - let core = - "inline-flex items-center justify-center gap-2 rounded-lg px-4 py-2 text-sm \ - font-medium transition-colors focus-visible:outline-none focus-visible:ring-2 \ - focus-visible:ring-action focus-visible:ring-offset-2 \ - focus-visible:ring-offset-surface disabled:opacity-40 \ - disabled:pointer-events-none" - - let colors = function - | Primary -> "bg-action text-on-action hover:bg-action-hover" - | Secondary -> "border border-border bg-surface text-ink hover:bg-action-subtle" - | Ghost -> "text-ink hover:bg-action-subtle" - | Destructive -> "bg-status-danger text-on-action hover:opacity-90" - - let component = fun ~variant ~label -> - -end - -let button_example () = -
    -
    - -(* ------------------------------------------------------------------ *) -(* element: badge *) -(* ------------------------------------------------------------------ *) - -module Badge = struct - type variant = - | Solid - | Soft - | Outline - - let base = "inline-flex items-center rounded-full px-2.5 py-0.5 text-xs font-medium " - - let tone = function - | Solid -> "bg-neutral-900 text-neutral-0" - | Soft -> "bg-neutral-200 text-neutral-800" - | Outline -> "border border-neutral-300 text-neutral-700" - - let component = fun ~variant ~label -> - (label) -end - -let badge_example () = -
    - - - - -
    - -(* ------------------------------------------------------------------ *) -(* component: alert (dismissible — demonstrates signals) *) -(* ------------------------------------------------------------------ *) - -module Alert = struct - type variant = - | Info - | Success - | Warning - | Danger - - let border = function - | Info -> "border-status-info" - | Success -> "border-status-success" - | Warning -> "border-status-warning" - | Danger -> "border-status-danger" - - let icon_color = function - | Info -> "text-status-info" - | Success -> "text-status-success" - | Warning -> "text-status-warning" - | Danger -> "text-status-danger" - - (* [role="alert"] is not one of the props the mlx element helper exposes, so - the root is built with the lower-level [View.div ~attrs] API. A local - [visible] signal drives the dismiss behaviour — the whole node is removed - from the DOM when it flips, with no re-render of anything else. *) - let component = fun ~variant ~title ~description -> - let visible = Signal.make true in - View.show - (fun () -> Signal.get visible) - (View.div - ~attrs: - [ View.Attr.make "role" (View.static "alert"); - View.Attr.className - (View.static - ("flex items-start gap-3 rounded-lg border bg-surface p-4 text-sm text-ink " - ^ border variant)) ] - [ ("\xe2\x97\x8f"); -
    -

    (title)

    -

    (description)

    -
    ; - ]) -end - -let alert_example () = -
    - - - - -
    - -(* ------------------------------------------------------------------ *) -(* block: cta-section (reactive email input) *) -(* ------------------------------------------------------------------ *) - -let cta_example () = - let email = Signal.make "" in - (* A Computed read directly in the JSX below (Signal.get can_submit) so the - mlx transform tracks it and the button restyles reactively as you type. *) - let can_submit = Computed.make (fun () -> String.length (String.trim (Signal.get email)) > 0) in -
    -

    ("Start building today")

    -

    - ("Join thousands of teams shipping faster. Free for 14 days.") -

    -
    - Signal.set email (Dom.target_value ev)) - /> - -
    -
    - -(* ------------------------------------------------------------------ *) -(* registry + mount entry (the JS surface consumed by the website) *) -(* ------------------------------------------------------------------ *) - -(* Mount the reativa example for [spec_id] into the element with id - [container_id]. The container is cleared first so re-selecting the tab - re-mounts cleanly instead of stacking copies. Called from ReScript via the - esbuild-bundled ES module (see website/src/ReativaExamples.res). *) -let mount_example spec_id container_id = - match Dom.by_id container_id with - | None -> () - | Some el -> - Dom.set_text_content el ""; - (match spec_id with - | "button" -> View.mount el (button_example ()) - | "badge" -> View.mount el (badge_example ()) - | "alert" -> View.mount el (alert_example ()) - | "cta-section" -> View.mount el (cta_example ()) - | _ -> ()) - -(* The spec ids that have a reativa implementation, exposed to the website so - it knows which specs get a "Reativa" tab. *) -let example_ids = [| "button"; "badge"; "alert"; "cta-section" |] - -(* Distinguishes the real compiled bundle from the checked-in placeholder. *) -let built = true diff --git a/website/scripts/build-reativa.mjs b/website/scripts/build-reativa.mjs index 4c562f4..6e5946f 100644 --- a/website/scripts/build-reativa.mjs +++ b/website/scripts/build-reativa.mjs @@ -1,82 +1,35 @@ -// Build the reativa (OCaml + Melange) example bundle consumed by the website's -// "Reativa" tab (see website/reativa/README.md). +// Build the reativa (OCaml + Melange) component bundle consumed by the website's +// "Reativa" preview, and drop it next to the website sources. // -// reativa's core library is a *private* dune library (no public_name), so it -// can't be consumed as an installed opam library — its own demo works only -// because it lives inside the reativa dune project. We do the same: clone -// reativa (pinned), drop website/reativa/{dune,xpecs_reativa.mlx} into a -// subdirectory of that project so the private `reativa` library and the -// `reativa.mlx_ppx` ppx resolve, compile to JS with Melange, then bundle the -// emitted entry into website/src/reativa.bundle.js with esbuild. +// The components live in the @xpecs/reativa package (packages/reativa); this +// script just delegates to that package's build (clone reativa → dune build +// @melange → esbuild bundle) and copies the resulting dist/reativa.bundle.js +// into website/src/reativa.bundle.js, overwriting the checked-in placeholder. // // Requires: opam switch with `dune`, `melange`, `mlx` installed, plus git and -// the website's esbuild devDependency. Not part of `npm run build`/CI's website -// build — invoked explicitly by `npm run reativa`. +// esbuild. Not part of `npm run build`/CI's website build — invoked explicitly +// by `npm run reativa`. import { execFileSync } from "node:child_process"; -import { existsSync, mkdirSync, copyFileSync, readdirSync } from "node:fs"; -import { resolve, join } from "node:path"; +import { copyFileSync } from "node:fs"; +import { resolve } from "node:path"; import { fileURLToPath } from "node:url"; -const REATIVA_REPO = "https://github.com/brnrdog/reativa.git"; -// Pin a known-good commit so the build is reproducible. Bump deliberately. -const REATIVA_REF = "c94697df4bcd16fae59f900a01f7c60964606492"; - const websiteDir = resolve(fileURLToPath(import.meta.url), "../.."); -const reativaDir = resolve(websiteDir, "reativa"); -const buildDir = resolve(reativaDir, ".build"); -const clone = resolve(buildDir, "reativa"); -const exDir = resolve(clone, "xpecs_examples"); - -const sh = (file, args, cwd) => - execFileSync(file, args, { cwd, stdio: "inherit" }); - -// 1. Clone reativa (or reuse a previous clone) and check out the pinned commit. -mkdirSync(buildDir, { recursive: true }); -if (!existsSync(resolve(clone, ".git"))) { - sh("git", ["clone", REATIVA_REPO, "reativa"], buildDir); -} -sh("git", ["fetch", "--quiet", "origin"], clone); -sh("git", ["checkout", "--quiet", REATIVA_REF], clone); - -// 2. Drop the example dune + source into the reativa project (same dune-project -// ⇒ the private `reativa` library and reativa.mlx_ppx are in scope). -mkdirSync(exDir, { recursive: true }); -copyFileSync(resolve(reativaDir, "dune"), resolve(exDir, "dune")); -copyFileSync( - resolve(reativaDir, "xpecs_reativa.mlx"), - resolve(exDir, "xpecs_reativa.mlx"), -); - -// 3. Compile the examples (and reativa itself) to ES modules via Melange. -sh("opam", ["exec", "--", "dune", "build", "@melange"], clone); - -// 4. Bundle the emitted entry into a single ES module under the website's src. -// melange.emit mirrors the source path under the target dir, so the entry is -// normally //.js — but locate it defensively in -// case the nesting differs across dune/melange versions. -const outputRoot = resolve(clone, "_build/default/xpecs_examples/output"); -const findEntry = (dir) => { - for (const name of readdirSync(dir, { withFileTypes: true })) { - const p = join(dir, name.name); - if (name.isDirectory()) { - const hit = findEntry(p); - if (hit) return hit; - } else if (name.name === "xpecs_reativa.js") { - return p; - } - } - return null; -}; -const entry = findEntry(outputRoot); -if (!entry) { - throw new Error(`could not find emitted xpecs_reativa.js under ${outputRoot}`); -} -const outfile = resolve(websiteDir, "src/reativa.bundle.js"); -sh( - "npx", - ["--yes", "esbuild", entry, "--bundle", "--format=esm", `--outfile=${outfile}`], - websiteDir, -); - -console.log(`\n✓ reativa bundle written to ${outfile}`); +const repoRoot = resolve(websiteDir, ".."); +const pkgDir = resolve(repoRoot, "packages/reativa"); + +// 1. Build @xpecs/reativa (generates Contracts.ml, compiles with Melange, and +// bundles to packages/reativa/dist/reativa.bundle.js). +execFileSync("npm", ["run", "build", "--workspace", "@xpecs/reativa"], { + cwd: repoRoot, + stdio: "inherit", +}); + +// 2. Copy the built bundle next to the website sources (overwrites the +// checked-in `built = false` placeholder with the real `built = true` one). +const src = resolve(pkgDir, "dist/reativa.bundle.js"); +const dest = resolve(websiteDir, "src/reativa.bundle.js"); +copyFileSync(src, dest); + +console.log(`\n✓ reativa bundle copied to ${dest}`); diff --git a/website/src/App.res b/website/src/App.res index 92040d1..cedb147 100644 --- a/website/src/App.res +++ b/website/src/App.res @@ -647,57 +647,77 @@ module NotFound = { module ExampleBlock = { @jsx.component let make = (~a: spec) => { - let mode = Signal.make("preview") + // Two independent tab strips: `view` picks the representation + // (preview / playground / code); `impl` picks which implementation renders + // in the preview (Xote or reativa). Code/playground stay Xote-only. + let view = Signal.make("preview") + let impl = Signal.make("xote") let copied = Signal.make(false) let full = Signal.make(false) let snippet = ExampleSource.get(a.id) let hasExample = Examples.get(a.id)->Option.isSome let hasReativa = ReativaExamples.has(a.id) let playground = Playground.get(a.id) - let tabCls = target => + // Segmented-control button classes, driven by the given signal + target. + let segCls = (get, target) => Computed.make(() => "rounded-md px-3 py-1 text-xs font-medium transition-colors " ++ ( - Signal.get(mode) == target ? "bg-action text-on-action" : "text-neutral-600 hover:text-neutral-900" + get() == target ? "bg-action text-on-action" : "text-neutral-600 hover:text-neutral-900" ) ) - let isPreview = Computed.make(() => Signal.get(mode) == "preview") - let isCode = Computed.make(() => Signal.get(mode) == "code") - let isPlay = Computed.make(() => Signal.get(mode) == "play") - let isReativa = Computed.make(() => Signal.get(mode) == "reativa") + let viewCls = target => segCls(() => Signal.get(view), target) + let implCls = target => segCls(() => Signal.get(impl), target) + let isCode = Computed.make(() => Signal.get(view) == "code") + let isPlay = Computed.make(() => Signal.get(view) == "play") + // In Preview, the implementation strip picks which library renders: Xote by + // default (or whenever there's no reativa build), reativa when selected. + let xotePreview = Computed.make(() => + Signal.get(view) == "preview" && (!hasReativa || Signal.get(impl) == "xote") + ) + let reativaPreview = Computed.make(() => + hasReativa && Signal.get(view) == "preview" && Signal.get(impl) == "reativa" + ) // Close fullscreen on Escape while it is open. Effect.run(() => Signal.get(full) ? Some(Ui.onEscape(() => Signal.set(full, false))) : None) - // When the Reativa tab is active, imperatively mount the OCaml/Melange + // While the reativa preview is showing, imperatively mount the OCaml/Melange // example into its container (the reativa runtime owns that subtree). Effect.run(() => { - if Signal.get(isReativa) && ReativaExamples.built { + if Signal.get(reativaPreview) && ReativaExamples.built { ReativaExamples.mount(a.id) } None })
    -
    -
    - - {switch playground { - | Some(_) => - - | None => View.null() - }} - {switch snippet { - | Some(_) => - - | None => View.null() - }} - {hasReativa - ? + | None => View.null() + }} + {switch snippet { + | Some(_) => + + | None => View.null() + }} +
    + {hasReativa + ?
    + + +
    : View.null()}
    @@ -716,11 +736,11 @@ module ExampleBlock = {
    - + {hasReativa - ? + ? {ReativaExamples.built ? // The reativa runtime mounts the OCaml/Melange example here.
    diff --git a/website/src/ReativaExamples.res b/website/src/ReativaExamples.res index 5ce02a4..6f613e5 100644 --- a/website/src/ReativaExamples.res +++ b/website/src/ReativaExamples.res @@ -1,6 +1,6 @@ -// Bridges the reativa (OCaml + Melange) example implementations into the -// ReScript/Xote website. The examples live in -// website/reativa/xpecs_reativa.mlx and are compiled + bundled to +// Bridges the reativa (OCaml + Melange) component implementations into the +// ReScript/Xote website. The components live in the @xpecs/reativa package +// (packages/reativa/src/*.mlx) and are compiled + bundled to // website/src/reativa.bundle.js by `npm run reativa`. // // Until that bundle is built, a checked-in placeholder stands in with @@ -8,12 +8,13 @@ // short build hint instead of the live components. @module("./reativa.bundle.js") external built: bool = "built" +@module("./reativa.bundle.js") external exampleIds: array = "example_ids" @module("./reativa.bundle.js") external mountExampleRaw: (string, string) => unit = "mount_example" -// The specs that have a reativa implementation — these get a "Reativa" tab in -// the example block, shown alongside the Xote "Preview". -let ids = ["button", "badge", "alert", "cta-section"] +// The specs that have a reativa implementation — these get a "Reativa" preview +// alongside the Xote one. Sourced from the bundle so the two never drift. +let ids = exampleIds let has = id => ids->Array.includes(id) // The dom id of the container the reativa runtime mounts a spec's example into. diff --git a/website/src/reativa.bundle.js b/website/src/reativa.bundle.js index 11c41d7..b3ab014 100644 --- a/website/src/reativa.bundle.js +++ b/website/src/reativa.bundle.js @@ -1,19 +1,27 @@ // PLACEHOLDER — not the real bundle. // -// The reativa (OCaml + Melange) Xpecs examples are compiled from -// website/reativa/xpecs_reativa.mlx. Building them needs the OCaml toolchain -// (opam + melange), which isn't part of the ReScript/Vite website build, so -// this checked-in stub keeps the site building and the "Reativa" tab present -// (showing a build hint) until the real bundle is generated. +// The reativa (OCaml + Melange) Xpecs components live in the @xpecs/reativa +// package (packages/reativa/src/*.mlx). Building them needs the OCaml toolchain +// (opam + melange), which isn't part of the ReScript/Vite website build, so this +// checked-in stub keeps the site building and the "Reativa" tab present (showing +// a build hint) until the real bundle is generated. // // To generate the real bundle (overwrites this file): // // cd website && npm run reativa // -// See website/reativa/README.md for the toolchain setup. +// which builds @xpecs/reativa and copies its dist/reativa.bundle.js here. +// See packages/reativa/README.md for the toolchain setup. export const built = false; -export const example_ids = ["button", "badge", "alert", "cta-section"]; +export const example_ids = [ + "aspect-ratio", "avatar", "badge", "button", "checkbox", "icon", "icon-button", + "input", "input-otp", "kbd", "link", "progress", "radio-group", "scroll-area", + "separator", "skeleton", "slider", "spinner", "switch", "textarea", "toggle", + "toggle-group", "accordion", "alert", "collapsible", "dialog", "field", "select", + "tabs", "tooltip", "announcement-bar", "contact-section", "logo-cloud", + "newsletter", "page-header", "stat-grid", "steps", +]; export function mount_example(_specId, _containerId) { /* no-op until the Melange bundle is built */ }