elm-ssr 0.2.0 → 0.5.0

package/{packages/elm-ssr/elm-src → elm-src}/ElmSsr/Loader.elm

@@ -9,6 +9,8 @@ module ElmSsr.Loader exposing
     , getCookie
     , enqueue
     , session, csrfToken, setSession, clearSession
+    , custom
+    , JobId, JobStatus(..), startJob, jobStatus
     , Effect, Step(..), step, encodeEffect
     )
 
@@ -45,6 +47,31 @@ request time.
 @docs session, csrfToken, setSession, clearSession
 
 
+# Custom effects
+
+Escape hatch for emitting a `kind` your own `EffectRunner` adapter handles.
+Use this to plug in things the framework does not cover natively — fan-out
+SQL with `Promise.all`, external services, vector search, queues. The shape
+of `payload` and the decoder for the result are entirely your contract with
+your adapter.
+
+@docs custom
+
+
+# Background jobs
+
+Long-running work that exceeds a single request budget. Submit a job with
+[`startJob`](#startJob) (returns an id immediately), poll progress with
+[`jobStatus`](#jobStatus). The TS-side `withJobs(runner, { store,
+handlers })` adapter persists records and runs handlers via `ctx.waitUntil`.
+
+A typical PRG flow: form action calls `startJob`, redirects to
+`/jobs/<id>`, that page polls `jobStatus` (or subscribes via SSE) and
+renders progress until `JobDone`.
+
+@docs JobId, JobStatus, startJob, jobStatus
+
+
 # Runtime interpretation
 
 These are used by the elm-ssr runtime to drive a loader. Application authors do
@@ -309,6 +336,156 @@ clearSession =
         (\_ -> Done ())
 
 
+{-| Emit a custom effect that your TS-side `EffectRunner` handles. The runner
+must inspect `effect.kind === <your kind>` and return
+`{ ok: true, value: <data> }`; the `decoder` runs against that value.
+
+The common use case is server-side fan-out — run several heavy SQL queries
+or external fetches with `Promise.all` inside one effect call, then return a
+combined payload so the route only awaits once:
+
+    -- Elm:
+    import Json.Decode as Decode
+
+    type alias Dashboard =
+        { totals : Int, recent : List Order, byCountry : List CountryStat }
+
+    dashboard : Loader Dashboard
+    dashboard =
+        Loader.custom
+            { kind = "parallelDashboard"
+            , payload = Encode.object []
+            , decoder = dashboardDecoder
+            }
+
+    -- TS adapter (wrap your existing runner):
+    const myEffects = async (effect, ctx) => {
+      if (effect.kind === "parallelDashboard") {
+        const [totals, recent, byCountry] = await Promise.all([
+          pg.unsafe("SELECT count(*) AS c FROM orders"),
+          pg.unsafe("SELECT * FROM orders ORDER BY created DESC LIMIT 10"),
+          pg.unsafe("SELECT country, sum(total) AS s FROM orders GROUP BY 1"),
+        ]);
+        return { ok: true, value: { totals: totals[0].c, recent, byCountry } };
+      }
+      return baseRunner(effect, ctx);
+    };
+
+See `docs/recipes/parallel-queries.md` for the full pattern.
+-}
+custom : { kind : String, payload : Encode.Value, decoder : Decoder a } -> Loader a
+custom config =
+    Pending
+        { kind = config.kind, payload = config.payload }
+        (\result -> resumeFetchJson config.decoder result)
+
+
+{-| Opaque handle to a submitted background job. Treat as a string for routing
+or storage; the TS-side store assigns it. -}
+type alias JobId =
+    String
+
+
+{-| The state of a job as the TS-side `JobStore` sees it. Decoded from the
+record by [`jobStatus`](#jobStatus); unknown ids decode as `JobMissing`.
+
+  - `JobQueued` — accepted, not yet running.
+  - `JobRunning { progress }` — currently executing; `progress` carries
+    whatever the handler last reported (or `Nothing`).
+  - `JobDone result` — handler resolved; `result` is the decoded value.
+  - `JobFailed { reason }` — handler threw; `reason` is the error message.
+  - `JobMissing` — no record under this id (TTL expired, never existed).
+
+-}
+type JobStatus a
+    = JobQueued
+    | JobRunning { progress : Maybe Decode.Value }
+    | JobDone a
+    | JobFailed { reason : String }
+    | JobMissing
+
+
+{-| Submit a background job. Returns the assigned `JobId` immediately —
+the handler runs after the response goes out (via `ctx.waitUntil` on
+Cloudflare, fire-and-forget locally).
+
+Pair `kind` with a handler registered in your TS-side
+`withJobs(runner, { handlers })`. `payload` is your handler's input;
+decoder for the result is on [`jobStatus`](#jobStatus).
+
+    submit : Action (Document Never)
+    submit =
+        Action.fromLoader
+            (Loader.startJob
+                { kind = "generateReport"
+                , payload = Encode.object [ ( "month", Encode.string "2026-05" ) ]
+                }
+            )
+            |> Action.andThen (\id -> Action.redirect ("/reports/" ++ id))
+
+-}
+startJob : { kind : String, payload : Encode.Value } -> Loader JobId
+startJob config =
+    Pending
+        { kind = "startJob"
+        , payload =
+            Encode.object
+                [ ( "kind", Encode.string config.kind )
+                , ( "payload", config.payload )
+                ]
+        }
+        (\result -> resumeFetchJson Decode.string result)
+
+
+{-| Read the current state of a submitted job. Decoded into [`JobStatus`](#JobStatus).
+The result decoder runs against the handler's return value when `status === "done"`.
+
+    statusLoader : JobId -> Loader (JobStatus Report)
+    statusLoader id =
+        Loader.jobStatus { jobId = id, decoder = reportDecoder }
+
+-}
+jobStatus : { jobId : JobId, decoder : Decoder a } -> Loader (JobStatus a)
+jobStatus config =
+    Pending
+        { kind = "jobStatus"
+        , payload = Encode.object [ ( "jobId", Encode.string config.jobId ) ]
+        }
+        (\result -> resumeFetchJson (jobStatusDecoder config.decoder) result)
+
+
+jobStatusDecoder : Decoder a -> Decoder (JobStatus a)
+jobStatusDecoder resultDecoder =
+    Decode.oneOf
+        [ Decode.null JobMissing
+        , Decode.field "status" Decode.string
+            |> Decode.andThen
+                (\status ->
+                    case status of
+                        "queued" ->
+                            Decode.succeed JobQueued
+
+                        "running" ->
+                            Decode.map (\progress -> JobRunning { progress = progress })
+                                (Decode.maybe (Decode.field "progress" Decode.value))
+
+                        "done" ->
+                            Decode.map JobDone (Decode.field "result" resultDecoder)
+
+                        "failed" ->
+                            Decode.map (\reason -> JobFailed { reason = reason })
+                                (Decode.oneOf
+                                    [ Decode.field "error" Decode.string
+                                    , Decode.succeed "Job failed without a message"
+                                    ]
+                                )
+
+                        other ->
+                            Decode.fail ("Unknown job status: " ++ other)
+                )
+        ]
+
+
 sqlPayload : String -> List Encode.Value -> Encode.Value
 sqlPayload sql params =
     Encode.object

package/package.json

@@ -1,33 +1,63 @@
 {
   "name": "elm-ssr",
-  "version": "0.2.0",
-  "type": "module",
-  "workspaces": [
-    "packages/*",
-    "examples/*"
+  "version": "0.5.0",
+  "description": "Elm-first SSR library and framework for Cloudflare Workers (and Bun): file-based routes/islands, backend-neutral effect adapters (KV/D1/Redis/Postgres), background tasks (waitUntil/Queues), SQL-file migrations, CLI scaffold + build.",
+  "license": "MIT",
+  "author": "Michał Majchrzak <michmajchrzak@gmail.com>",
+  "homepage": "https://github.com/the-man-with-a-golden-mind/elm-ssr#readme",
+  "bugs": {
+    "url": "https://github.com/the-man-with-a-golden-mind/elm-ssr/issues"
+  },
+  "repository": {
+    "type": "git",
+    "url": "git+https://github.com/the-man-with-a-golden-mind/elm-ssr.git",
+    "directory": "packages/elm-ssr"
+  },
+  "keywords": [
+    "elm",
+    "ssr",
+    "server-side-rendering",
+    "cloudflare-workers",
+    "bun",
+    "islands",
+    "framework",
+    "edge",
+    "file-based-routing",
+    "migrations"
   ],
-  "scripts": {
-    "build:elm": "bun packages/elm-ssr/bin/elm-ssr.mjs build",
-    "build": "bun run build:elm",
-    "check": "bun run build && bun ./node_modules/typescript/bin/tsc --noEmit",
-    "ssr:build": "bun packages/elm-ssr/bin/elm-ssr.mjs build",
-    "ssr:new": "bun packages/elm-ssr/bin/elm-ssr.mjs new",
-    "ssr:routes": "bun packages/elm-ssr/bin/elm-ssr.mjs routes",
-    "test": "docker compose up -d --wait && (DATABASE_URL=postgres://elmssr:elmssr@localhost:5432/elmssr REDIS_URL=redis://localhost:6379 sh -c 'bun run build && bun test'; ec=$?; docker compose down; exit $ec)",
-    "test:unit": "bun run build && bun test $(find test -name '*.test.ts' -not -path '*/integration/*')",
-    "test:integration": "docker compose up -d --wait && (DATABASE_URL=postgres://elmssr:elmssr@localhost:5432/elmssr REDIS_URL=redis://localhost:6379 sh -c 'bun run build && bun test test/integration/'; ec=$?; docker compose down; exit $ec)",
-    "bench": "bun run build && bun run scripts/benchmark.mjs",
-    "dev": "bun run build && ./node_modules/.bin/wrangler dev",
-    "deploy": "bun run build && ./node_modules/.bin/wrangler deploy"
+  "type": "module",
+  "scripts": {},
+  "bin": {
+    "elm-ssr": "bin/elm-ssr.mjs"
+  },
+  "main": "./src/app.ts",
+  "exports": {
+    ".": "./src/app.ts",
+    "./render": "./src/render.ts",
+    "./http": "./src/http.ts",
+    "./effects": "./src/effects.ts",
+    "./tasks": "./src/tasks.ts",
+    "./backends": "./src/backends.ts",
+    "./migrations": "./src/migrations.ts",
+    "./middleware": "./src/middleware.ts",
+    "./sessions": "./src/sessions/index.ts",
+    "./sse": "./src/sse.ts",
+    "./jobs": "./src/jobs/index.ts",
+    "./response-headers": "./src/response-headers.ts",
+    "./serialize": "./src/serialize.ts",
+    "./protocol": "./src/protocol.ts",
+    "./islands-runtime": "./src/client-runtime/islands.ts"
   },
+  "files": [
+    "bin",
+    "lib",
+    "elm-src",
+    "src"
+  ],
   "engines": {
     "bun": ">=1.3"
   },
-  "devDependencies": {
-    "elm-ssr": "workspace:*",
-    "elm": "^0.19.1-6",
-    "happy-dom": "^20.9.0",
-    "typescript": "^5.9.0",
-    "wrangler": "^4.0.0"
+  "dependencies": {
+    "cookie": "^1.0.1"
   }
 }

package/{packages/elm-ssr/src → src}/client-runtime/islands.ts

@@ -23,6 +23,8 @@ function createIslandsRuntime(deps) {
       return;
     }
 
+    const teardowns = [];
+
     if (app.ports.broadcastOut) {
       app.ports.broadcastOut.subscribe((event) => {
         window.dispatchEvent(new window.CustomEvent("elm-ssr-broadcast", { detail: event }));
@@ -32,7 +34,69 @@ function createIslandsRuntime(deps) {
     if (app.ports.broadcastIn) {
       const handler = (event) => app.ports.broadcastIn.send(event.detail);
       window.addEventListener("elm-ssr-broadcast", handler);
-      cleanups.set(marker, () => window.removeEventListener("elm-ssr-broadcast", handler));
+      teardowns.push(() => window.removeEventListener("elm-ssr-broadcast", handler));
+    }
+
+    // Server-Sent Events ports. One EventSource per (url, island); the island
+    // opens/closes via sseOpen/sseClose, and receives raw frames via sseEventIn.
+    if (app.ports.sseOpen || app.ports.sseClose || app.ports.sseEventIn || app.ports.sseErrorIn) {
+      const sources = new Map(); // url -> EventSource
+
+      const open = (url) => {
+        if (sources.has(url)) {
+          return;
+        }
+        let source;
+        try {
+          source = new window.EventSource(url);
+        } catch (error) {
+          if (app.ports.sseErrorIn) {
+            app.ports.sseErrorIn.send({ url, message: String(error) });
+          }
+          return;
+        }
+        source.onmessage = (event) => {
+          if (app.ports.sseEventIn) {
+            app.ports.sseEventIn.send({ url, data: typeof event.data === "string" ? event.data : "" });
+          }
+        };
+        source.onerror = () => {
+          if (app.ports.sseErrorIn) {
+            app.ports.sseErrorIn.send({ url, message: "EventSource error" });
+          }
+        };
+        sources.set(url, source);
+      };
+
+      const close = (url) => {
+        const source = sources.get(url);
+        if (source) {
+          source.close();
+          sources.delete(url);
+        }
+      };
+
+      if (app.ports.sseOpen) {
+        app.ports.sseOpen.subscribe(open);
+      }
+      if (app.ports.sseClose) {
+        app.ports.sseClose.subscribe(close);
+      }
+
+      teardowns.push(() => {
+        for (const source of sources.values()) {
+          source.close();
+        }
+        sources.clear();
+      });
+    }
+
+    if (teardowns.length > 0) {
+      cleanups.set(marker, () => {
+        for (const fn of teardowns) {
+          fn();
+        }
+      });
     }
   };
 
@@ -128,30 +192,64 @@ function createIslandsRuntime(deps) {
     }
   };
 
-  const managedHeadNodes = (head) => {
-    const metas = Array.prototype.slice.call(head.getElementsByTagName("meta"));
-    const links = Array.prototype.slice
+  const stylesheetLinks = (head) =>
+    Array.prototype.slice
       .call(head.getElementsByTagName("link"))
       .filter((link) => link.getAttribute("rel") === "stylesheet");
-    return metas.concat(links);
-  };
 
-  const syncHead = (sourceDoc) => {
-    document.title = sourceDoc.title;
+  const metaNodes = (head) => Array.prototype.slice.call(head.getElementsByTagName("meta"));
+
+  // Stable signature for diffing: href (+ media if set) for stylesheets,
+  // full attribute set for metas. Two nodes with the same signature are
+  // treated as identical; we never tear one down and re-create it.
+  const stylesheetKey = (link) => (link.getAttribute("href") || "") + "|" + (link.getAttribute("media") || "");
+  const metaKey = (meta) =>
+    meta
+      .getAttributeNames()
+      .sort()
+      .map((name) => name + "=" + meta.getAttribute(name))
+      .join("|");
+
+  // Diff-based sync: only add what's new, only remove what's gone. Avoids the
+  // flash of unstyled content that came from removing-then-readding the
+  // <link rel=stylesheet>, even when the href was identical across pages.
+  const syncCollection = (currentNodes, incomingNodes, keyOf) => {
+    const currentByKey = new Map();
+    for (const node of currentNodes) {
+      currentByKey.set(keyOf(node), node);
+    }
+    const incomingByKey = new Map();
+    for (const node of incomingNodes) {
+      incomingByKey.set(keyOf(node), node);
+    }
 
-    for (const node of managedHeadNodes(document.head)) {
-      node.remove();
+    // Remove only what's not in the incoming doc.
+    for (const [key, node] of currentByKey) {
+      if (!incomingByKey.has(key)) {
+        node.remove();
+      }
     }
 
-    for (const node of managedHeadNodes(sourceDoc.head)) {
-      const copy = document.createElement(node.tagName);
-      for (const name of node.getAttributeNames()) {
-        copy.setAttribute(name, node.getAttribute(name));
+    // Add only what's not already present.
+    for (const [key, node] of incomingByKey) {
+      if (!currentByKey.has(key)) {
+        const copy = document.createElement(node.tagName);
+        for (const name of node.getAttributeNames()) {
+          copy.setAttribute(name, node.getAttribute(name));
+        }
+        document.head.appendChild(copy);
       }
-      document.head.appendChild(copy);
     }
   };
 
+  const syncHead = (sourceDoc) => {
+    if (document.title !== sourceDoc.title) {
+      document.title = sourceDoc.title;
+    }
+    syncCollection(stylesheetLinks(document.head), stylesheetLinks(sourceDoc.head), stylesheetKey);
+    syncCollection(metaNodes(document.head), metaNodes(sourceDoc.head), metaKey);
+  };
+
   const navigate = async (url, push = true) => {
     try {
       const response = await window.fetch("/api/render?path=" + encodeURIComponent(url.pathname + url.search));

package/src/jobs/index.ts

@@ -0,0 +1,7 @@
+// Public API for the background-job layer. Wrap your effect runner with
+// `withJobs(runner, { store, handlers })` to enable `Loader.startJob` /
+// `Loader.jobStatus` on the Elm side.
+
+export { memoryJobStore, cacheJobStore, type CacheJobStoreOptions } from "./store";
+export { withJobs, type JobsConfig } from "./runner";
+export type { JobRecord, JobStore, JobContext, JobHandler, JobHandlers } from "./types";

package/src/jobs/runner.ts

@@ -0,0 +1,137 @@
+import type { EffectContext, EffectRunner } from "../effects";
+import type { JobContext, JobHandlers, JobRecord, JobStore } from "./types";
+
+export interface JobsConfig {
+  /** Where to persist job records. Use `memoryJobStore()` in dev/tests, `cacheJobStore(redisCache(...))` in prod. */
+  store: JobStore;
+  /** Named job handlers. Each maps `kind` → async function returning the result. */
+  handlers: JobHandlers;
+  /** Default record TTL in seconds (default `60 * 60 * 24` = 24h). */
+  defaultTtlSeconds?: number;
+}
+
+const DEFAULT_TTL = 60 * 60 * 24;
+
+const generateJobId = (): string => crypto.randomUUID();
+
+const runJob = (
+  store: JobStore,
+  handler: JobHandlers[string] | undefined,
+  record: JobRecord,
+  context: EffectContext
+): Promise<void> =>
+  Promise.resolve().then(async () => {
+    if (!handler) {
+      await store.set(record.id, {
+        ...record,
+        status: "failed",
+        error: `No handler registered for kind "${record.kind}"`,
+        finishedAt: Date.now()
+      });
+      return;
+    }
+
+    const aborter = new AbortController();
+    // If the request's signal is still around (e.g. Bun fetch), wire it through;
+    // otherwise the job runs to completion regardless.
+    if (context.request) {
+      const reqSignal = context.request.signal;
+      if (reqSignal.aborted) {
+        aborter.abort();
+      } else {
+        reqSignal.addEventListener("abort", () => aborter.abort(), { once: true });
+      }
+    }
+
+    let progressVersion = 0;
+    const jobContext: JobContext = {
+      jobId: record.id,
+      reportProgress: async (value) => {
+        progressVersion += 1;
+        const current = await store.get(record.id);
+        if (!current) return;
+        await store.set(record.id, { ...current, progress: value });
+      },
+      signal: aborter.signal
+    };
+
+    const startedAt = Date.now();
+    await store.set(record.id, { ...record, status: "running", startedAt });
+
+    try {
+      const result = await handler(record.payload, jobContext);
+      await store.set(record.id, {
+        ...record,
+        status: "done",
+        startedAt,
+        finishedAt: Date.now(),
+        result
+      });
+    } catch (error) {
+      console.error(`elm-ssr: job "${record.kind}" (${record.id}) failed`, error);
+      await store.set(record.id, {
+        ...record,
+        status: "failed",
+        startedAt,
+        finishedAt: Date.now(),
+        error: String(error instanceof Error ? error.message : error)
+      });
+    }
+
+    // Mark "finished progress version" so concurrent reportProgress calls after completion are no-ops.
+    void progressVersion;
+  });
+
+/**
+ * Wraps an effect runner so `Loader.startJob` schedules a background job and
+ * `Loader.jobStatus` reads its current record. Jobs run via `ctx.waitUntil`
+ * on Cloudflare (isolate stays alive); locally (no waitUntil) they run
+ * fire-and-forget. All other effects pass through unchanged.
+ *
+ * Use a durable `JobStore` (cacheJobStore over Redis/KV) in production —
+ * `memoryJobStore` is process-local and lost on isolate restart.
+ */
+export const withJobs = (runner: EffectRunner, config: JobsConfig): EffectRunner => {
+  const ttlSeconds = config.defaultTtlSeconds ?? DEFAULT_TTL;
+
+  return async (effect, context) => {
+    if (effect.kind === "startJob") {
+      const kind = String(effect.payload.kind ?? "");
+      if (!kind) {
+        return { ok: false, error: 'startJob requires a non-empty "kind"' };
+      }
+
+      const id = generateJobId();
+      const record: JobRecord = {
+        id,
+        kind,
+        payload: effect.payload.payload ?? null,
+        status: "queued",
+        expiresAt: Date.now() + ttlSeconds * 1000
+      };
+      await config.store.set(id, record);
+
+      const work = runJob(config.store, config.handlers[kind], record, context);
+      if (typeof context.waitUntil === "function") {
+        context.waitUntil(work);
+      } else {
+        void work.catch((error) => console.error("elm-ssr: job scheduling failed", error));
+      }
+
+      return { ok: true, value: id };
+    }
+
+    if (effect.kind === "jobStatus") {
+      const id = String(effect.payload.jobId ?? "");
+      if (!id) {
+        return { ok: false, error: 'jobStatus requires a non-empty "jobId"' };
+      }
+      const record = await config.store.get(id);
+      // Returning the raw record (or null for unknown id). Elm-side decoder
+      // turns this into JobStatus a.
+      return { ok: true, value: record };
+    }
+
+    return runner(effect, context);
+  };
+};

package/src/jobs/store.ts

@@ -0,0 +1,60 @@
+import type { CacheBackend } from "../backends";
+import type { JobRecord, JobStore } from "./types";
+
+/** In-memory job store. Useful for dev/tests; lost on process restart. */
+export const memoryJobStore = (initial?: Map<string, JobRecord>): JobStore => {
+  const store = initial ?? new Map<string, JobRecord>();
+  return {
+    get: async (id) => {
+      const record = store.get(id);
+      if (!record) return null;
+      if (record.expiresAt !== undefined && record.expiresAt <= Date.now()) {
+        store.delete(id);
+        return null;
+      }
+      return record;
+    },
+    set: async (id, record) => {
+      store.set(id, record);
+    },
+    delete: async (id) => {
+      store.delete(id);
+    }
+  };
+};
+
+export interface CacheJobStoreOptions {
+  /** Cache-key prefix (default `"elm-ssr:job:"`). */
+  keyPrefix?: string;
+  /** Default TTL in seconds when the record has no `expiresAt`. */
+  defaultTtlSeconds?: number;
+}
+
+/**
+ * Job store backed by an existing `CacheBackend` — wire it on
+ * `redisCache(...)`, a KV-backed cache, or anything matching the interface.
+ * Records are namespaced via the key prefix to avoid colliding with your
+ * other cache uses.
+ */
+export const cacheJobStore = (backend: CacheBackend, options: CacheJobStoreOptions = {}): JobStore => {
+  const prefix = options.keyPrefix ?? "elm-ssr:job:";
+  const defaultTtl = options.defaultTtlSeconds;
+
+  return {
+    get: async (id) => {
+      const value = await backend.get(prefix + id);
+      return (value ?? null) as JobRecord | null;
+    },
+    set: async (id, record) => {
+      const ttl =
+        record.expiresAt !== undefined
+          ? Math.max(1, Math.ceil((record.expiresAt - Date.now()) / 1000))
+          : defaultTtl;
+      await backend.put(prefix + id, record, ttl);
+    },
+    delete: async (id) => {
+      // CacheBackend has no delete; tombstone with TTL=1s.
+      await backend.put(prefix + id, null, 1);
+    }
+  };
+};