elm-ssr 0.3.0 → 0.5.0

package/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,6 +1,6 @@
 {
   "name": "elm-ssr",
-  "version": "0.3.0",
+  "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>",
@@ -42,6 +42,7 @@
     "./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",

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);
+    }
+  };
+};

package/src/jobs/types.ts

@@ -0,0 +1,41 @@
+/** A persisted background job. The lifecycle is queued → running → done | failed. */
+export interface JobRecord {
+  id: string;
+  kind: string;
+  /** Payload the job was started with. */
+  payload: unknown;
+  status: "queued" | "running" | "done" | "failed";
+  /** User-supplied progress payload (set via `reportProgress`). */
+  progress?: unknown;
+  /** Result payload when `status === "done"`. */
+  result?: unknown;
+  /** Error message when `status === "failed"`. */
+  error?: string;
+  /** Epoch ms when the handler started executing. */
+  startedAt?: number;
+  /** Epoch ms when the handler resolved or rejected. */
+  finishedAt?: number;
+  /** Epoch ms at which the store may evict the record. */
+  expiresAt?: number;
+}
+
+/** Driver-agnostic job storage. Wire memory / cache / SQL behind it. */
+export interface JobStore {
+  get(id: string): Promise<JobRecord | null>;
+  set(id: string, record: JobRecord): Promise<void>;
+  delete(id: string): Promise<void>;
+}
+
+/** Per-job context passed to the handler. */
+export interface JobContext {
+  jobId: string;
+  /** Update the record's `progress` field. Safe to call concurrently with the handler's work. */
+  reportProgress: (value: unknown) => Promise<void>;
+  /** Fires when the request context is gone (Worker isolate teardown) or store TTL elapses. */
+  signal: AbortSignal;
+}
+
+/** A handler for a named job kind. Returns the result; throw to mark failed. */
+export type JobHandler = (payload: unknown, context: JobContext) => Promise<unknown> | unknown;
+
+export type JobHandlers = Record<string, JobHandler>;