elm-ssr 0.1.0

package/elm-src/ElmSsr/Island/Shared.elm

@@ -0,0 +1,38 @@
+port module ElmSsr.Island.Shared exposing (GlobalEvent, broadcast, listen)
+
+{-| Standardized ports for cross-island communication.
+
+Islands are isolated by default. Use these functions to communicate across island
+boundaries using the browser's global event bus.
+
+@docs GlobalEvent, broadcast, listen
+-}
+
+import Json.Encode exposing (Value)
+
+
+{-| A message captured from the global event bus. -}
+type alias GlobalEvent =
+    { tag : String
+    , payload : Value
+    }
+
+
+port broadcastOut : GlobalEvent -> Cmd msg
+
+
+port broadcastIn : (GlobalEvent -> msg) -> Sub msg
+
+
+{-| Send a message to all other islands. -}
+broadcast : String -> Value -> Cmd msg
+broadcast tag payload =
+    broadcastOut { tag = tag, payload = payload }
+
+
+{-| Subscribe to the global event bus. You should filter by `tag` in your `update`
+function to ignore messages intended for other components.
+-}
+listen : (GlobalEvent -> msg) -> Sub msg
+listen =
+    broadcastIn

package/elm-src/ElmSsr/Island.elm

@@ -0,0 +1,49 @@
+module ElmSsr.Island exposing
+    ( Config
+    , embed
+    )
+
+{-| Embed a standard `Browser.element` island into an SSR page.
+
+An island is mounted client-side by plain Elm, not by a custom DOM patcher. The
+server emits a marker element with encoded flags plus optional fallback markup.
+The browser runtime later finds that marker and runs the island's own
+`main : Program flags model msg`.
+
+This keeps authoring compatible with normal `elm/html`, `Html.Keyed`, `elm/http`
+and the broader Elm ecosystem.
+
+
+# Embedding
+
+@docs Config, embed
+
+-}
+
+import ElmSsr.Html as Html exposing (Node)
+import Json.Encode as Encode
+
+
+{-| SSR-side config for embedding an island. -}
+type alias Config flags pageMsg =
+    { encodeFlags : flags -> Encode.Value
+    , fallback : flags -> List (Node pageMsg)
+    , id : Maybe String
+    }
+
+
+{-| Render the island marker into a page.
+
+The `name` must match the generated browser bundle key for the island module.
+`fallback` is optional SSR-only markup shown before the client bundle mounts.
+-}
+embed : String -> Config flags pageMsg -> flags -> Node pageMsg
+embed name config flags =
+    Html.element "elm-ssr-island"
+        (List.filterMap identity
+            [ Just (Html.Property "data-elmssr-island" name)
+            , Just (Html.Property "data-elmssr-props" (Encode.encode 0 (config.encodeFlags flags)))
+            , config.id |> Maybe.map (Html.Property "data-elmssr-id")
+            ]
+        )
+        (config.fallback flags)

package/elm-src/ElmSsr/Loader.elm

@@ -0,0 +1,297 @@
+module ElmSsr.Loader exposing
+    ( Loader
+    , succeed, fail
+    , map, map2, andThen
+    , fetchJson
+    , cacheGet, cachePut
+    , query, queryOne, execute
+    , env
+    , enqueue
+    , Effect, Step(..), step, encodeEffect
+    )
+
+{-| A `Loader` describes the data a route needs before it can render.
+
+It is a plain description, not a side effect. The author composes loaders with
+`succeed`, `map`, `andThen`, and effect helpers like `fetchJson`; the elm-ssr
+runtime interprets the description, asking the Worker to run the real IO and
+feeding results back until the loader resolves.
+
+This means loaders run on the server only, never touch ports by hand, and stay
+fully typed end to end.
+
+
+# Building loaders
+
+@docs Loader
+@docs succeed, fail
+@docs map, map2, andThen
+@docs fetchJson
+@docs cacheGet, cachePut
+@docs query, queryOne, execute
+@docs env
+@docs enqueue
+
+
+# Runtime interpretation
+
+These are used by the elm-ssr runtime to drive a loader. Application authors do
+not need them.
+
+@docs Effect, Step, step, encodeEffect
+
+-}
+
+import Json.Decode as Decode exposing (Decoder)
+import Json.Encode as Encode
+
+
+{-| A description of how to produce a value of type `a` on the server. -}
+type Loader a
+    = Done a
+    | Failed Int String
+    | Pending Effect (Decode.Value -> Loader a)
+
+
+{-| A single side effect the Worker knows how to run, addressed by `kind`. -}
+type alias Effect =
+    { kind : String
+    , payload : Encode.Value
+    }
+
+
+{-| A loader that needs no work and resolves immediately. -}
+succeed : a -> Loader a
+succeed value =
+    Done value
+
+
+{-| Abort a load with an HTTP status and message. The runtime renders an error
+response instead of the page.
+-}
+fail : Int -> String -> Loader a
+fail status message =
+    Failed status message
+
+
+{-| Transform the value a loader resolves to. -}
+map : (a -> b) -> Loader a -> Loader b
+map fn loader =
+    case loader of
+        Done value ->
+            Done (fn value)
+
+        Failed status message ->
+            Failed status message
+
+        Pending effect continue ->
+            Pending effect (\value -> map fn (continue value))
+
+
+{-| Run a second loader that depends on the first loader's result. Loaders run
+sequentially, so each effect completes before the next begins.
+-}
+andThen : (a -> Loader b) -> Loader a -> Loader b
+andThen fn loader =
+    case loader of
+        Done value ->
+            fn value
+
+        Failed status message ->
+            Failed status message
+
+        Pending effect continue ->
+            Pending effect (\value -> andThen fn (continue value))
+
+
+{-| Combine two loaders. They run one after the other. -}
+map2 : (a -> b -> c) -> Loader a -> Loader b -> Loader c
+map2 fn first second =
+    first |> andThen (\a -> map (fn a) second)
+
+
+{-| Fetch a URL and decode its JSON body into a value.
+
+    type alias Status =
+        { uptime : String }
+
+    statusLoader : Loader Status
+    statusLoader =
+        fetchJson
+            { url = "https://api.example.com/status"
+            , decoder =
+                Decode.map Status (Decode.field "uptime" Decode.string)
+            }
+
+The Worker performs the actual `fetch`. A non-2xx response or a decode mismatch
+fails the loader with a `502`.
+-}
+fetchJson : { url : String, decoder : Decoder a } -> Loader a
+fetchJson config =
+    Pending
+        { kind = "fetchJson"
+        , payload = Encode.object [ ( "url", Encode.string config.url ) ]
+        }
+        (\result -> resumeFetchJson config.decoder result)
+
+
+{-| Read a value from the cache, or `Nothing` on a miss. Backend-neutral: the
+runner maps it to Cloudflare KV, Redis locally, etc. -}
+cacheGet : { key : String, decoder : Decoder a } -> Loader (Maybe a)
+cacheGet config =
+    Pending
+        { kind = "cacheGet"
+        , payload = Encode.object [ ( "key", Encode.string config.key ) ]
+        }
+        (\result -> resumeFetchJson (Decode.nullable config.decoder) result)
+
+
+{-| Write a value to the cache, with an optional TTL in seconds. -}
+cachePut : { key : String, value : Encode.Value, ttlSeconds : Maybe Int } -> Loader ()
+cachePut config =
+    let
+        fields =
+            [ ( "key", Encode.string config.key ), ( "value", config.value ) ]
+                ++ (case config.ttlSeconds of
+                        Just ttl ->
+                            [ ( "ttlSeconds", Encode.int ttl ) ]
+
+                        Nothing ->
+                            []
+                   )
+    in
+    Pending
+        { kind = "cachePut", payload = Encode.object fields }
+        (\_ -> Done ())
+
+
+{-| Run a SQL query and decode every row. Backend-neutral: the runner maps it to
+Cloudflare D1, Postgres/SQLite locally, etc. Use `?` placeholders with `params`. -}
+query : { sql : String, params : List Encode.Value, decoder : Decoder a } -> Loader (List a)
+query config =
+    Pending
+        { kind = "query", payload = sqlPayload config.sql config.params }
+        (\result -> resumeFetchJson (Decode.list config.decoder) result)
+
+
+{-| Run a SQL query and decode only the first row, if any. -}
+queryOne : { sql : String, params : List Encode.Value, decoder : Decoder a } -> Loader (Maybe a)
+queryOne config =
+    Pending
+        { kind = "queryOne", payload = sqlPayload config.sql config.params }
+        (\result -> resumeFetchJson (Decode.nullable config.decoder) result)
+
+
+{-| Execute a statement (INSERT/UPDATE/DELETE) and return the number of rows
+affected. Typically used by an `Action` via `Action.fromLoader`. -}
+execute : { sql : String, params : List Encode.Value } -> Loader { rowsAffected : Int }
+execute config =
+    Pending
+        { kind = "execute", payload = sqlPayload config.sql config.params }
+        (\result ->
+            resumeFetchJson
+                (Decode.map (\rows -> { rowsAffected = rows }) (Decode.field "rowsAffected" Decode.int))
+                result
+        )
+
+
+{-| Read an environment variable / secret / binding name. -}
+env : String -> Loader (Maybe String)
+env name =
+    Pending
+        { kind = "env", payload = Encode.object [ ( "name", Encode.string name ) ]
+        }
+        (\result -> resumeFetchJson (Decode.nullable Decode.string) result)
+
+
+{-| Enqueue a background task to run after the response (fire-and-forget). The
+named handler lives in the Worker's task adapter; the request does not wait for
+it. Typically used from an `Action` via `Action.fromLoader`. -}
+enqueue : { task : String, payload : Encode.Value } -> Loader ()
+enqueue config =
+    Pending
+        { kind = "enqueue"
+        , payload =
+            Encode.object
+                [ ( "task", Encode.string config.task )
+                , ( "payload", config.payload )
+                ]
+        }
+        (\result -> resumeFetchJson (Decode.succeed ()) result)
+
+
+sqlPayload : String -> List Encode.Value -> Encode.Value
+sqlPayload sql params =
+    Encode.object
+        [ ( "sql", Encode.string sql )
+        , ( "params", Encode.list identity params )
+        ]
+
+
+resumeFetchJson : Decoder a -> Decode.Value -> Loader a
+resumeFetchJson decoder result =
+    case Decode.decodeValue effectOutcomeDecoder result of
+        Ok (Ok body) ->
+            case Decode.decodeValue decoder body of
+                Ok value ->
+                    Done value
+
+                Err decodeError ->
+                    Failed 502 ("Loader response did not match decoder: " ++ Decode.errorToString decodeError)
+
+        Ok (Err message) ->
+            Failed 502 message
+
+        Err decodeError ->
+            Failed 500 ("Malformed loader effect result: " ++ Decode.errorToString decodeError)
+
+
+effectOutcomeDecoder : Decoder (Result String Decode.Value)
+effectOutcomeDecoder =
+    Decode.field "ok" Decode.bool
+        |> Decode.andThen
+            (\ok ->
+                if ok then
+                    Decode.map Ok (Decode.field "value" Decode.value)
+
+                else
+                    Decode.map Err
+                        (Decode.oneOf
+                            [ Decode.field "error" Decode.string
+                            , Decode.succeed "Loader effect failed"
+                            ]
+                        )
+            )
+
+
+{-| One observable step of a loader: it is done, it failed, or it is waiting on
+an effect. The runtime resumes a pending loader by calling the continuation with
+the effect result.
+-}
+type Step a
+    = Resolved a
+    | Errored Int String
+    | Await Effect (Decode.Value -> Loader a)
+
+
+{-| Inspect the next step of a loader. -}
+step : Loader a -> Step a
+step loader =
+    case loader of
+        Done value ->
+            Resolved value
+
+        Failed status message ->
+            Errored status message
+
+        Pending effect continue ->
+            Await effect continue
+
+
+{-| Encode an effect as the JSON request the Worker receives. -}
+encodeEffect : Effect -> Encode.Value
+encodeEffect effect =
+    Encode.object
+        [ ( "kind", Encode.string effect.kind )
+        , ( "payload", effect.payload )
+        ]

package/elm-src/ElmSsr/Page.elm

@@ -0,0 +1,102 @@
+module ElmSsr.Page exposing
+    ( document
+    , error
+    , metaCharset
+    , metaName
+    , metaViewport
+    , notFound
+    , page
+    , stylesheet
+    , title
+    )
+
+import ElmSsr.Document exposing (Document)
+import ElmSsr.Html as Html exposing (Node, link, meta, text)
+import ElmSsr.Html.Attributes exposing (attr, href, rel)
+
+
+document :
+    { status : Int
+    , lang : String
+    , head : List (Node msg)
+    , body : List (Node msg)
+    }
+    -> Document msg
+document config =
+    { status = config.status
+    , lang = config.lang
+    , hasIslands = Html.anyIsland config.body
+    , head = config.head
+    , body = config.body
+    }
+
+
+page :
+    { title : String
+    , head : List (Node msg)
+    , body : List (Node msg)
+    }
+    -> Document msg
+page config =
+    document
+        { status = 200
+        , lang = "en"
+        , head = title config.title :: config.head
+        , body = config.body
+        }
+
+
+notFound :
+    { title : String
+    , head : List (Node msg)
+    , body : List (Node msg)
+    }
+    -> Document msg
+notFound config =
+    document
+        { status = 404
+        , lang = "en"
+        , head = title config.title :: config.head
+        , body = config.body
+        }
+
+
+title : String -> Node msg
+title value =
+    Html.Element "title" [] [ text value ]
+
+
+error : Int -> String -> Document Never
+error status message =
+    { status = status
+    , lang = "en"
+    , hasIslands = False
+    , head = [ title ("Error " ++ String.fromInt status) ]
+    , body =
+        [ Html.Element "main"
+            []
+            [ Html.Element "h1" [] [ text (String.fromInt status) ]
+            , Html.Element "p" [] [ text message ]
+            ]
+        ]
+    }
+
+
+stylesheet : String -> Node msg
+stylesheet path =
+    link [ rel "stylesheet", href path ]
+
+
+metaCharset : String -> Node msg
+metaCharset charset =
+    meta [ attr "charset" charset ]
+
+
+metaViewport : String -> Node msg
+metaViewport content =
+    meta [ attr "name" "viewport", attr "content" content ]
+
+
+metaName : String -> String -> Node msg
+metaName name content =
+    meta [ attr "name" name, attr "content" content ]

package/elm-src/ElmSsr/Route.elm

@@ -0,0 +1,136 @@
+module ElmSsr.Route exposing
+    ( Request
+    , segments, method, query
+    , param, params
+    , formValue
+    , decoder
+    )
+
+{-| The incoming request a route is matched against.
+
+Routing is file-based, so you rarely match paths by hand. Instead, dynamic
+segments captured from a file name (e.g. `Routes/Posts/Slug_.elm` →
+`/posts/:slug`) are available through [`param`](#param).
+
+
+# Request
+
+@docs Request
+@docs segments, method, query
+
+
+# Dynamic route params
+
+@docs param, params
+
+
+# Form data
+
+@docs formValue
+
+
+# Decoding
+
+@docs decoder
+
+-}
+
+import Json.Decode as Decode exposing (Decoder)
+
+
+{-| Everything the runtime knows about an incoming request.
+
+`params` holds the dynamic segments captured by the generated router; it is
+empty for static routes.
+-}
+type alias Request =
+    { method : String
+    , path : String
+    , query : List ( String, String )
+    , params : List ( String, String )
+    , formData : List ( String, String )
+    }
+
+
+{-| The path split into non-empty segments.
+
+    -- request.path == "/posts/hello"
+    segments request --> [ "posts", "hello" ]
+
+-}
+segments : Request -> List String
+segments request =
+    request.path
+        |> String.split "/"
+        |> List.filter (not << String.isEmpty)
+
+
+{-| The HTTP method, uppercased by the runtime (e.g. `"GET"`). -}
+method : Request -> String
+method request =
+    request.method
+
+
+{-| Look up a query string parameter by name.
+
+    -- request.path == "/search?q=elm"
+    query "q" request --> Just "elm"
+
+-}
+query : String -> Request -> Maybe String
+query key request =
+    lookup key request.query
+
+
+{-| Look up a dynamic route segment by name.
+
+    -- Routes/Posts/Slug_.elm matched against /posts/hello
+    param "slug" request --> Just "hello"
+
+-}
+param : String -> Request -> Maybe String
+param key request =
+    lookup key request.params
+
+
+{-| All captured dynamic segments, as name/value pairs. -}
+params : Request -> List ( String, String )
+params request =
+    request.params
+
+
+{-| Look up a form value by name. -}
+formValue : String -> Request -> Maybe String
+formValue key request =
+    lookup key request.formData
+
+
+lookup : String -> List ( String, String ) -> Maybe String
+lookup key pairs =
+    pairs
+        |> List.filter (\( name, _ ) -> name == key)
+        |> List.head
+        |> Maybe.map Tuple.second
+
+
+{-| Decode the request the Worker passes in as flags. Dynamic params are filled
+in by the generated router, not by the Worker, so they start empty.
+-}
+decoder : Decoder Request
+decoder =
+    Decode.map4
+        (\requestMethod path queryPairs formDataPairs ->
+            { method = requestMethod, path = path, query = queryPairs, params = [], formData = formDataPairs }
+        )
+        (Decode.oneOf [ Decode.field "method" Decode.string, Decode.succeed "GET" ])
+        (Decode.field "path" Decode.string)
+        (Decode.oneOf
+            [ Decode.field "query" (Decode.keyValuePairs Decode.string)
+            , Decode.succeed []
+            ]
+        )
+        (Decode.oneOf
+            [ Decode.field "formData" (Decode.keyValuePairs Decode.string)
+            , Decode.succeed []
+            ]
+        )