elm-ssr 0.1.0

package/README.md

@@ -0,0 +1,67 @@
+# elm-ssr
+
+Elm-first SSR library and framework for Cloudflare Workers (and Bun locally).
+One package, three pieces:
+
+- A **CLI** (`elm-ssr build|new|migrate|dev`) that scans your routes/islands,
+  generates the router + manifest, and runs `elm make`.
+- A **Worker runtime** (`createWorkerApp`, `renderApp`, effect adapters,
+  background tasks, SQL migrations, middleware) exported via subpaths.
+- A set of **Elm authoring modules** under `elm-src/ElmSsr/` (Route, Loader,
+  Action, Html, Svg, Island, Page, Document, Runtime) which the build syncs
+  into each app's `.elm-ssr/src/ElmSsr/`.
+
+## Install
+
+```sh
+bun add elm-ssr
+```
+
+Then use the CLI as `elm-ssr <command>` (or `bun elm-ssr <command>` in a
+workspace) and import the runtime via subpaths.
+
+## CLI commands
+
+- **`elm-ssr build`** — scans each configured app's `src/<Namespace>/Routes/`
+  and `Islands/`, generates `.elm-ssr/Main.elm` (the router with file-based
+  routes + dynamic segments) and the islands manifest, syncs the Elm authoring
+  modules into the app's `.elm-ssr/src/ElmSsr/`, and compiles via `elm make`
+  (one combined island bundle exposing `Elm.<App>.Islands.<Name>`).
+- **`elm-ssr new <name>`** — scaffold a new app and register it in
+  `elm-ssr.config.json`.
+- **`elm-ssr dev`** — `build` then `wrangler dev`.
+- **`elm-ssr compress`** — pre-compress generated bundles with gzip.
+- **`elm-ssr migrate <up|down|status>`** — apply / revert / inspect SQL-file
+  migrations. `--db postgres://…`, `sqlite://path`, or a plain SQLite file path;
+  `--dir <path>` (default `./migrations`); `--count N` (for `down`, default 1).
+  Reads `DATABASE_URL` if `--db` is omitted.
+
+Configuration lives in `elm-ssr.config.json` at the repo root:
+
+```jsonc
+{
+  "apps": [
+    { "name": "basic", "root": "examples/basic", "module": "Example.Basic" }
+  ]
+}
+```
+
+## Runtime exports
+
+```ts
+import { createWorkerApp } from "elm-ssr";
+import { renderApp, type CompiledElmModule } from "elm-ssr/render";
+import type { RouteCatalog } from "elm-ssr/http";
+import { inMemoryEffects, cloudflareEffects } from "elm-ssr/effects";
+import { withCache, redisCache, postgresSql } from "elm-ssr/backends";
+import { withTasks, withQueueProducer, createQueueConsumer } from "elm-ssr/tasks";
+import { runMigrations, revertMigrations, listMigrations } from "elm-ssr/migrations";
+import { composeMiddleware } from "elm-ssr/middleware";
+```
+
+See the [top-level README](../../README.md) for end-to-end usage and the
+authoring guide.
+
+## License
+
+MIT.

package/bin/elm-ssr.mjs

@@ -0,0 +1,102 @@
+#!/usr/bin/env bun
+
+import { readFile } from "node:fs/promises";
+import { resolve } from "node:path";
+import { createExampleScaffold } from "../lib/scaffold.mjs";
+import { readWorkspaceConfig } from "../lib/workspace.mjs";
+import { build } from "../lib/build.mjs";
+import { migrate } from "../lib/migrate.mjs";
+
+const defaultRootPath = process.cwd();
+const packageJsonPath = resolve(defaultRootPath, "package.json");
+
+let packageJson = { name: "unknown" };
+try {
+  packageJson = JSON.parse(await readFile(packageJsonPath, "utf8"));
+} catch {
+  // Not in a package root, that's okay for some commands
+}
+const args = process.argv.slice(2);
+const command = args[0] ?? "help";
+
+const findFlagValue = (flagName) => {
+  const index = args.indexOf(flagName);
+  return index >= 0 ? args[index + 1] : undefined;
+};
+
+const rootPath = resolve(findFlagValue("--root") ?? defaultRootPath);
+
+const run = async (cmd, cmdArgs, cwd = rootPath) => {
+  const child = Bun.spawn([cmd, ...cmdArgs], {
+    cwd,
+    stdout: "inherit",
+    stderr: "inherit",
+    stdin: "inherit",
+    env: process.env
+  });
+
+  const exitCode = await child.exited;
+
+  if (exitCode !== 0) {
+    process.exit(exitCode);
+  }
+};
+
+const printHelp = () => {
+  console.log(`elm-ssr commands
+
+  build         Generate wrapper modules and compile configured Elm SSR apps
+  compress      Pre-compress island and app bundles using Gzip for faster edge delivery
+  dev           Build and start wrangler dev using the current workspace config
+  new <name>    Create a new example app and register it in elm-ssr.config.json
+  routes        Print configured apps and their public modules
+  info          Print current workspace package and configured app names
+  migrate ...   Apply / revert / inspect SQL migrations (see: elm-ssr migrate --help)
+`);
+};
+
+const config = await readWorkspaceConfig(rootPath);
+
+switch (command) {
+  case "build":
+  case "compress":
+    await build({ rootPath, config });
+    break;
+
+  case "dev":
+    await run("bun", ["run", "build"], rootPath);
+    await run("./node_modules/.bin/wrangler", ["dev"], rootPath);
+    break;
+
+  case "new": {
+    const name = args[1];
+
+    if (!name) {
+      console.error("Usage: elm-ssr new <name>");
+      process.exit(1);
+    }
+
+    const created = await createExampleScaffold(rootPath, name);
+    console.log(`Created ${created.name} at ${created.root}`);
+    break;
+  }
+
+  case "routes":
+    for (const app of config.apps) {
+      console.log(`${app.name}: root=${app.root} module=${app.module} routes=src/${app.module.split(".").join("/")}/Routes`);
+    }
+    break;
+
+  case "info":
+    console.log(`workspace: ${packageJson.name}`);
+    console.log(`apps: ${config.apps.map((app) => app.name).join(", ")}`);
+    break;
+
+  case "migrate":
+    await migrate(args.slice(1));
+    break;
+
+  default:
+    printHelp();
+    break;
+}

package/elm-src/ElmSsr/Action.elm

@@ -0,0 +1,210 @@
+module ElmSsr.Action exposing
+    ( Action
+    , succeed, fail, redirect, json
+    , map, andThen, fromLoader
+    , Effect, Step(..), step, encodeStep
+    )
+
+{-| An `Action` describes what should happen in response to a non-GET request
+(usually a `POST` form submission).
+
+Like `Loader`, it is a description of work, not a side effect: the author
+composes it, and the runtime interprets it — running any effects through the
+Worker — until it resolves to a document, a redirect, a JSON body, or an error.
+
+A typical form action validates `Route.formValue`s, performs an effect, then
+redirects (the Post/Redirect/Get pattern):
+
+    action request =
+        case Route.formValue "email" request of
+            Nothing ->
+                Action.fail 422 "Email is required"
+
+            Just email ->
+                Action.fromLoader (saveSubscriber email)
+                    |> Action.andThen (\_ -> Action.redirect "/thanks")
+
+
+# Building actions
+
+@docs Action
+@docs succeed, fail, redirect, json
+@docs map, andThen, fromLoader
+
+
+# Runtime interpretation
+
+Used by the elm-ssr runtime to drive an action. Application authors do not need
+these.
+
+@docs Effect, Step, step, encodeStep
+
+-}
+
+import ElmSsr.Loader as Loader exposing (Loader)
+import Json.Decode as Decode
+import Json.Encode as Encode
+
+
+{-| A description of how to respond to a non-GET request. -}
+type Action a
+    = Done a
+    | Failed Int String
+    | Redirect String
+    | JsonResult Encode.Value
+    | Pending Effect (Decode.Value -> Action a)
+
+
+{-| A single side effect the Worker runs, addressed by `kind`. Shared with
+[`ElmSsr.Loader`](./Loader.elm), so actions reuse the same effect vocabulary. -}
+type alias Effect =
+    Loader.Effect
+
+
+{-| An action that resolves to a value with no further work. -}
+succeed : a -> Action a
+succeed =
+    Done
+
+
+{-| Fail an action with an HTTP status and message. -}
+fail : Int -> String -> Action a
+fail =
+    Failed
+
+
+{-| Redirect the client to a new URL (303-style Post/Redirect/Get). -}
+redirect : String -> Action a
+redirect =
+    Redirect
+
+
+{-| Respond with a JSON body directly. -}
+json : Encode.Value -> Action a
+json =
+    JsonResult
+
+
+{-| Transform the value an action resolves to. -}
+map : (a -> b) -> Action a -> Action b
+map fn action =
+    case action of
+        Done value ->
+            Done (fn value)
+
+        Failed status message ->
+            Failed status message
+
+        Redirect url ->
+            Redirect url
+
+        JsonResult value ->
+            JsonResult value
+
+        Pending effect continue ->
+            Pending effect (\value -> map fn (continue value))
+
+
+{-| Sequence actions: run a second step that depends on the first's result.
+Effects run one after the other, each completing before the next begins. -}
+andThen : (a -> Action b) -> Action a -> Action b
+andThen fn action =
+    case action of
+        Done value ->
+            fn value
+
+        Failed status message ->
+            Failed status message
+
+        Redirect url ->
+            Redirect url
+
+        JsonResult value ->
+            JsonResult value
+
+        Pending effect continue ->
+            Pending effect (\value -> andThen fn (continue value))
+
+
+{-| Lift a [`Loader`](./Loader.elm) into an action so its effects run as part of
+the action. This is how an action does server work (fetch, KV, D1, …) before
+deciding how to respond. -}
+fromLoader : Loader a -> Action a
+fromLoader loader =
+    case Loader.step loader of
+        Loader.Resolved value ->
+            Done value
+
+        Loader.Errored status message ->
+            Failed status message
+
+        Loader.Await effect continue ->
+            Pending effect (\value -> fromLoader (continue value))
+
+
+{-| One observable step of an action. The runtime resumes a pending action by
+calling the continuation with the effect result. -}
+type Step a
+    = Resolved a
+    | Errored Int String
+    | Moved String
+    | SentJson Encode.Value
+    | Await Effect (Decode.Value -> Action a)
+
+
+{-| Inspect the next step of an action. -}
+step : Action a -> Step a
+step action =
+    case action of
+        Done value ->
+            Resolved value
+
+        Failed status message ->
+            Errored status message
+
+        Redirect url ->
+            Moved url
+
+        JsonResult value ->
+            SentJson value
+
+        Pending effect continue ->
+            Await effect continue
+
+
+{-| Encode a terminal step for the Worker runtime. `Await` is never encoded —
+the runtime runs its effect first — so it is reported defensively as an error. -}
+encodeStep : (a -> Encode.Value) -> Step a -> Encode.Value
+encodeStep encoder step_ =
+    case step_ of
+        Resolved value ->
+            Encode.object
+                [ ( "kind", Encode.string "resolved" )
+                , ( "value", encoder value )
+                ]
+
+        Errored status message ->
+            Encode.object
+                [ ( "kind", Encode.string "errored" )
+                , ( "status", Encode.int status )
+                , ( "message", Encode.string message )
+                ]
+
+        Moved url ->
+            Encode.object
+                [ ( "kind", Encode.string "redirect" )
+                , ( "url", Encode.string url )
+                ]
+
+        SentJson value ->
+            Encode.object
+                [ ( "kind", Encode.string "json" )
+                , ( "value", value )
+                ]
+
+        Await _ _ ->
+            Encode.object
+                [ ( "kind", Encode.string "errored" )
+                , ( "status", Encode.int 500 )
+                , ( "message", Encode.string "Action step was not resolved before encoding." )
+                ]

package/elm-src/ElmSsr/Document/Encode.elm

@@ -0,0 +1,83 @@
+module ElmSsr.Document.Encode exposing (encode)
+
+{-| Serialize a document to the JSON the JS runtime renders and patches.
+
+@docs encode
+
+-}
+
+import ElmSsr.Document exposing (Document)
+import ElmSsr.Document.Events as Events
+import ElmSsr.Html exposing (Attribute(..), EventCapture(..), Node(..))
+import Json.Encode as Encode
+
+
+encode : Document msg -> Encode.Value
+encode document =
+    Encode.object
+        [ ( "status", Encode.int document.status )
+        , ( "lang", Encode.string document.lang )
+        , ( "hasIslands", Encode.bool document.hasIslands )
+        , ( "head", Encode.list identity (List.indexedMap (\index node -> encodeNode [ index ] node) document.head) )
+        , ( "body", Encode.list identity (List.indexedMap (\index node -> encodeNode [ index ] node) document.body) )
+        ]
+
+
+encodeNode : List Int -> Node msg -> Encode.Value
+encodeNode path node =
+    case node of
+        Element tag attributes children ->
+            Encode.object
+                [ ( "kind", Encode.string "element" )
+                , ( "tag", Encode.string tag )
+                , ( "attrs", Encode.list identity (List.map (encodeAttribute path) attributes) )
+                , ( "children", Encode.list identity (List.indexedMap (\index child -> encodeNode (path ++ [ index ]) child) children) )
+                ]
+
+        VoidElement tag attributes ->
+            Encode.object
+                [ ( "kind", Encode.string "void" )
+                , ( "tag", Encode.string tag )
+                , ( "attrs", Encode.list identity (List.map (encodeAttribute path) attributes) )
+                ]
+
+        Text content ->
+            Encode.object
+                [ ( "kind", Encode.string "text" )
+                , ( "text", Encode.string content )
+                ]
+
+
+encodeAttribute : List Int -> Attribute msg -> Encode.Value
+encodeAttribute path attribute =
+    case attribute of
+        Property name value ->
+            Encode.object
+                [ ( "kind", Encode.string "attribute" )
+                , ( "name", Encode.string name )
+                , ( "value", Encode.string value )
+                ]
+
+        EventHandler name capture _ ->
+            Encode.object
+                [ ( "kind", Encode.string "event" )
+                , ( "name", Encode.string name )
+                , ( "payload"
+                  , Events.encodeEventRef
+                        { path = path
+                        , event = name
+                        , value = Nothing
+                        }
+                  )
+                , ( "capture", encodeEventCapture capture )
+                ]
+
+
+encodeEventCapture : EventCapture -> Encode.Value
+encodeEventCapture capture =
+    case capture of
+        NoEventData ->
+            Encode.string "none"
+
+        TargetValue ->
+            Encode.string "value"

package/elm-src/ElmSsr/Document/Events.elm

@@ -0,0 +1,125 @@
+module ElmSsr.Document.Events exposing (EventRef, decodeEventRef, encodeEventRef, findMessage)
+
+{-| Browser events are bridged without serializing `Msg`. An event handler is
+rendered as an `EventRef` (a DOM path + event name); when the browser reports an
+event, the runtime looks the message back up against the current view with
+[`findMessage`](#findMessage).
+
+@docs EventRef, decodeEventRef, encodeEventRef, findMessage
+
+-}
+
+import ElmSsr.Document exposing (Document)
+import ElmSsr.Html exposing (Attribute(..), EventValue(..), Node(..))
+import Json.Decode as Decode
+import Json.Encode as Encode
+
+
+type alias EventRef =
+    { path : List Int
+    , event : String
+    , value : Maybe String
+    }
+
+
+encodeEventRef : EventRef -> Encode.Value
+encodeEventRef eventRef =
+    Encode.object
+        [ ( "path", Encode.list Encode.int eventRef.path )
+        , ( "event", Encode.string eventRef.event )
+        , ( "value", maybeString eventRef.value )
+        ]
+
+
+decodeEventRef : Decode.Decoder EventRef
+decodeEventRef =
+    Decode.map3 EventRef
+        (Decode.field "path" (Decode.list Decode.int))
+        (Decode.field "event" Decode.string)
+        (Decode.maybe (Decode.field "value" Decode.string))
+
+
+maybeString : Maybe String -> Encode.Value
+maybeString maybeValue =
+    case maybeValue of
+        Just value ->
+            Encode.string value
+
+        Nothing ->
+            Encode.null
+
+
+findMessage : EventRef -> Document msg -> Maybe msg
+findMessage eventRef document =
+    document.body
+        |> getNode eventRef.path
+        |> Maybe.andThen (findMessageOnNode eventRef)
+
+
+getNode : List Int -> List (Node msg) -> Maybe (Node msg)
+getNode path nodes =
+    case path of
+        [] ->
+            Nothing
+
+        index :: rest ->
+            case List.drop index nodes |> List.head of
+                Just node ->
+                    if List.isEmpty rest then
+                        Just node
+
+                    else
+                        case node of
+                            Element _ _ children ->
+                                getNode rest children
+
+                            VoidElement _ _ ->
+                                Nothing
+
+                            Text _ ->
+                                Nothing
+
+                Nothing ->
+                    Nothing
+
+
+findMessageOnNode : EventRef -> Node msg -> Maybe msg
+findMessageOnNode eventRef node =
+    case node of
+        Element _ attributes _ ->
+            findMessageOnAttributes eventRef attributes
+
+        VoidElement _ attributes ->
+            findMessageOnAttributes eventRef attributes
+
+        Text _ ->
+            Nothing
+
+
+findMessageOnAttributes : EventRef -> List (Attribute msg) -> Maybe msg
+findMessageOnAttributes eventRef attributes =
+    case attributes of
+        [] ->
+            Nothing
+
+        attribute :: rest ->
+            case attribute of
+                EventHandler name _ toMessage ->
+                    if name == eventRef.event then
+                        Just (toMessage (eventValueFromRef eventRef))
+
+                    else
+                        findMessageOnAttributes eventRef rest
+
+                Property _ _ ->
+                    findMessageOnAttributes eventRef rest
+
+
+eventValueFromRef : EventRef -> EventValue
+eventValueFromRef eventRef =
+    case eventRef.value of
+        Just value ->
+            StringValue value
+
+        Nothing ->
+            NoValue

package/elm-src/ElmSsr/Document.elm

@@ -0,0 +1,26 @@
+module ElmSsr.Document exposing (Document, map)
+
+import ElmSsr.Html as Html exposing (Node)
+
+
+type alias Document msg =
+    { status : Int
+    , lang : String
+    , hasIslands : Bool
+    , head : List (Node msg)
+    , body : List (Node msg)
+    }
+
+
+{-| Reinterpret the message type of a document. Used to lift a stateless
+`Document Never` (a page that cannot emit events) into the runtime's message
+type via `Document.map never`.
+-}
+map : (a -> b) -> Document a -> Document b
+map fn document =
+    { status = document.status
+    , lang = document.lang
+    , hasIslands = document.hasIslands
+    , head = List.map (Html.mapNode fn) document.head
+    , body = List.map (Html.mapNode fn) document.body
+    }