Use byte encodings for content.dat in dev server.

generator/src/Pages/Internal/Platform.elm

@@ -26,13 +26,13 @@ import Pages.ProgramConfig exposing (ProgramConfig)
 import Pages.StaticHttpRequest as StaticHttpRequest
 import Path exposing (Path)
 import QueryParams
-import Task
+import Task exposing (Task)
 import Url exposing (Url)
 
 
 {-| -}
 type alias Program userModel userMsg pageData sharedData =
-    Platform.Program Flags (Model userModel pageData sharedData) (Msg userMsg)
+    Platform.Program Flags (Model userModel pageData sharedData) (Msg userMsg pageData)
 
 
 mainView :
@@ -87,7 +87,7 @@ urlsToPagePath urls =
 view :
     ProgramConfig userMsg userModel route siteData pageData sharedData
     -> Model userModel pageData sharedData
-    -> Browser.Document (Msg userMsg)
+    -> Browser.Document (Msg userMsg pageData)
 view config model =
     let
         { title, body } =
@@ -126,7 +126,7 @@ init :
     -> Flags
     -> Url
     -> Browser.Navigation.Key
-    -> ( Model userModel pageData sharedData, Cmd (Msg userMsg) )
+    -> ( Model userModel pageData sharedData, Cmd (Msg userMsg pageData) )
 init config flags url key =
     let
         contentCache : ContentCache
@@ -222,7 +222,7 @@ init config flags url key =
                                         }
                                         |> config.init userFlags sharedData pageData (Just key)
 
-                                cmd : Cmd (Msg userMsg)
+                                cmd : Cmd (Msg userMsg pageData)
                                 cmd =
                                     [ userCmd
                                         |> Cmd.map UserMsg
@@ -291,12 +291,13 @@ init config flags url key =
 
 
 {-| -}
-type Msg userMsg
+type Msg userMsg pageData
     = LinkClicked Browser.UrlRequest
     | UrlChanged Url
     | UserMsg userMsg
     | UpdateCache (Result Http.Error ( Url, ContentJson, ContentCache ))
     | UpdateCacheAndUrl Url (Result Http.Error ( Url, ContentJson, ContentCache ))
+    | UpdateCacheAndUrlNew Url (Result Http.Error pageData)
     | PageScrollComplete
     | HotReloadComplete ContentJson
     | ReloadCurrentPageData
@@ -323,9 +324,9 @@ type alias Model userModel pageData sharedData =
 {-| -}
 update :
     ProgramConfig userMsg userModel route siteData pageData sharedData
-    -> Msg userMsg
+    -> Msg userMsg pageData
     -> Model userModel pageData sharedData
-    -> ( Model userModel pageData sharedData, Cmd (Msg userMsg) )
+    -> ( Model userModel pageData sharedData, Cmd (Msg userMsg pageData) )
 update config appMsg model =
     case appMsg of
         LinkClicked urlRequest ->
@@ -411,9 +412,8 @@ update config appMsg model =
 
             else
                 ( model
-                , model.contentCache
-                    |> ContentCache.lazyLoad urls
-                    |> Task.attempt (UpdateCacheAndUrl url)
+                , config.fetchPageData url
+                    |> Task.attempt (UpdateCacheAndUrlNew url)
                 )
 
         ReloadCurrentPageData ->
@@ -459,6 +459,70 @@ update config appMsg model =
                     -- TODO handle error
                     ( model, Cmd.none )
 
+        UpdateCacheAndUrlNew url cacheUpdateResult ->
+            case Result.map2 Tuple.pair (cacheUpdateResult |> Result.mapError (\_ -> "Http error")) model.pageData of
+                Ok ( newPageData, previousPageData ) ->
+                    let
+                        updatedPageData : { userModel : userModel, sharedData : sharedData, pageData : pageData }
+                        updatedPageData =
+                            { userModel = userModel
+                            , sharedData = previousPageData.sharedData
+                            , pageData = newPageData
+                            }
+
+                        ( userModel, userCmd ) =
+                            config.update
+                                previousPageData.sharedData
+                                newPageData
+                                (Just model.key)
+                                (config.onPageChange
+                                    { protocol = model.url.protocol
+                                    , host = model.url.host
+                                    , port_ = model.url.port_
+                                    , path = url |> urlPathToPath config
+                                    , query = url.query
+                                    , fragment = url.fragment
+                                    , metadata = config.urlToRoute url
+                                    }
+                                )
+                                previousPageData.userModel
+
+                        updatedModel : Model userModel pageData sharedData
+                        updatedModel =
+                            { model
+                                | url = url
+                                , pageData = Ok updatedPageData
+                            }
+                    in
+                    ( { updatedModel
+                        | ariaNavigationAnnouncement = mainView config updatedModel |> .title
+                      }
+                    , Cmd.batch
+                        [ userCmd |> Cmd.map UserMsg
+                        , Task.perform (\_ -> PageScrollComplete) (Dom.setViewport 0 0)
+                        ]
+                    )
+
+                Err error ->
+                    {-
+                       When there is an error loading the content.json, we are either
+                       1) in the dev server, and should show the relevant DataSource error for the page
+                          we're navigating to. This could be done more cleanly, but it's simplest to just
+                          do a fresh page load and use the code path for presenting an error for a fresh page.
+                       2) In a production app. That means we had a successful build, so there were no DataSource failures,
+                          so the app must be stale (unless it's in some unexpected state from a bug). In the future,
+                          it probably makes sense to include some sort of hash of the app version we are fetching, match
+                          it with the current version that's running, and perform this logic when we see there is a mismatch.
+                          But for now, if there is any error we do a full page load (not a single-page navigation), which
+                          gives us a fresh version of the app to make sure things are in sync.
+
+                    -}
+                    ( model
+                    , url
+                        |> Url.toString
+                        |> Browser.Navigation.load
+                    )
+
         UpdateCacheAndUrl url cacheUpdateResult ->
             case
                 Result.map2 Tuple.pair (cacheUpdateResult |> Result.mapError (\_ -> "Http error")) model.pageData
@@ -732,7 +796,7 @@ update config appMsg model =
 {-| -}
 application :
     ProgramConfig userMsg userModel route staticData pageData sharedData
-    -> Platform.Program Flags (Model userModel pageData sharedData) (Msg userMsg)
+    -> Platform.Program Flags (Model userModel pageData sharedData) (Msg userMsg pageData)
 application config =
     Browser.application
         { init =

generator/src/Pages/Internal/Platform/Cli.elm

@@ -8,6 +8,8 @@ module Pages.Internal.Platform.Cli exposing (Flags, Model, Msg(..), Program, cli
 
 import ApiRoute
 import BuildError exposing (BuildError)
+import Bytes exposing (Bytes)
+import Bytes.Encode
 import Codec
 import DataSource exposing (DataSource)
 import DataSource.Http exposing (RequestDetails)
@@ -323,6 +325,35 @@ perform site renderRequest config toJsPort effect =
                         |> Task.perform (\_ -> Continue)
                 ]
 
+        Effect.SendSinglePageNew done rawBytes info ->
+            let
+                currentPagePath : String
+                currentPagePath =
+                    case info of
+                        ToJsPayload.PageProgress toJsSuccessPayloadNew ->
+                            toJsSuccessPayloadNew.route
+
+                        _ ->
+                            ""
+
+                newCommandThing =
+                    { oldThing =
+                        info
+                            |> Codec.encoder (ToJsPayload.successCodecNew2 canonicalSiteUrl currentPagePath)
+                    , binaryPageData = rawBytes
+                    }
+                        |> config.sendPageData
+                        |> Cmd.map never
+            in
+            Cmd.batch
+                [ newCommandThing
+                , if True then
+                    Cmd.none
+
+                  else
+                    Cmd.none
+                ]
+
         Effect.Continue ->
             Cmd.none
 
@@ -792,11 +823,30 @@ nextStepToEffect site contentCache config model ( updatedStaticResponsesModel, n
                                                                 site.data
                                                                 (staticData |> Dict.map (\_ v -> Just v))
                                                                 |> Result.mapError (StaticHttpRequest.toBuildError "Site.elm")
+
+                                                        byteEncodedPageData : Bytes
+                                                        byteEncodedPageData =
+                                                            case pageDataResult of
+                                                                Ok pageServerResponse ->
+                                                                    case pageServerResponse of
+                                                                        PageServerResponse.RenderPage _ pageData ->
+                                                                            Bytes.Encode.encode (config.byteEncodePageData pageData)
+
+                                                                        PageServerResponse.ServerResponse serverResponse ->
+                                                                            Bytes.Encode.encode (Bytes.Encode.unsignedInt8 0)
+
+                                                                _ ->
+                                                                    -- TODO handle error?
+                                                                    Bytes.Encode.encode (Bytes.Encode.unsignedInt8 0)
                                                     in
                                                     case Result.map3 (\a b c -> ( a, b, c )) pageFoundResult renderedResult siteDataResult of
                                                         Ok ( pageFound, renderedOrApiResponse, siteData ) ->
                                                             case renderedOrApiResponse of
                                                                 PageServerResponse.RenderPage responseInfo rendered ->
+                                                                    let
+                                                                        _ =
+                                                                            Debug.log "@@@SendOld" 4
+                                                                    in
                                                                     { route = payload.path |> Path.toRelative
                                                                     , contentJson =
                                                                         --toJsPayload.pages
@@ -813,7 +863,7 @@ nextStepToEffect site contentCache config model ( updatedStaticResponsesModel, n
                                                                     , headers = responseInfo.headers
                                                                     }
                                                                         |> ToJsPayload.PageProgress
-                                                                        |> Effect.SendSinglePage False
+                                                                        |> Effect.SendSinglePageNew False byteEncodedPageData
 
                                                                 PageServerResponse.ServerResponse serverResponse ->
                                                                     { body = serverResponse |> PageServerResponse.toJson
@@ -840,18 +890,76 @@ nextStepToEffect site contentCache config model ( updatedStaticResponsesModel, n
                     )
 
                 StaticResponses.Page contentJson ->
+                    let
+                        currentUrl : Url.Url
+                        currentUrl =
+                            { protocol = Url.Https
+                            , host = site.canonicalUrl
+                            , port_ = Nothing
+                            , path = "TODO" --payload.path |> Path.toRelative
+                            , query = Nothing
+                            , fragment = Nothing
+                            }
+
+                        routeResult : Result BuildError route
+                        routeResult =
+                            model.staticRoutes
+                                |> Maybe.map (List.map Tuple.second)
+                                |> Maybe.andThen List.head
+                                -- TODO is it possible to remove the Maybe here?
+                                |> Result.fromMaybe (StaticHttpRequest.toBuildError "TODO url" (StaticHttpRequest.DecoderError "Expected route"))
+
+                        pageDataResult : Result BuildError (PageServerResponse pageData)
+                        pageDataResult =
+                            routeResult
+                                |> Result.andThen
+                                    (\route ->
+                                        StaticHttpRequest.resolve ApplicationType.Browser
+                                            (config.data route)
+                                            (contentJson |> Dict.map (\_ v -> Just v))
+                                            |> Result.mapError (StaticHttpRequest.toBuildError "TODO url")
+                                    )
+
+                        byteEncodedPageData : Bytes
+                        byteEncodedPageData =
+                            case pageDataResult of
+                                Ok pageServerResponse ->
+                                    case pageServerResponse of
+                                        PageServerResponse.RenderPage _ pageData ->
+                                            Bytes.Encode.encode (config.byteEncodePageData pageData)
+
+                                        PageServerResponse.ServerResponse serverResponse ->
+                                            -- TODO handle error?
+                                            Bytes.Encode.encode (Bytes.Encode.unsignedInt8 0)
+
+                                _ ->
+                                    -- TODO handle error?
+                                    Bytes.Encode.encode (Bytes.Encode.unsignedInt8 0)
+                    in
                     case model.unprocessedPages |> List.head of
                         Just pageAndMetadata ->
+                            let
+                                _ =
+                                    Debug.log "@@@SendOld" 14
+                            in
                             ( model
                             , sendSinglePageProgress site contentJson config model pageAndMetadata
                             )
 
                         Nothing ->
+                            let
+                                _ =
+                                    Debug.log "@@@SendOld" 13
+                            in
                             ( model
-                            , [] |> ToJsPayload.Errors |> Effect.SendSinglePage True
+                            , [] |> ToJsPayload.Errors |> Effect.SendSinglePageNew True byteEncodedPageData
                             )
 
                 StaticResponses.Errors errors ->
+                    let
+                        _ =
+                            Debug.log "@@@SendOld" 12
+                    in
                     ( model
                     , errors |> ToJsPayload.Errors |> Effect.SendSinglePage True
                     )
@@ -986,7 +1094,7 @@ sendSinglePageProgress site contentJson config model =
                                         , headers = responseInfo.headers
                                         }
                                             |> ToJsPayload.PageProgress
-                                            |> Effect.SendSinglePage True
+                                            |> Effect.SendSinglePageNew True byteEncodedPageData
 
                                     PageServerResponse.ServerResponse serverResponse ->
                                         { body = serverResponse |> PageServerResponse.toJson

generator/src/Pages/Internal/Platform/Effect.elm

@@ -1,5 +1,6 @@
 module Pages.Internal.Platform.Effect exposing (Effect(..))
 
+import Bytes exposing (Bytes)
 import DataSource.Http exposing (RequestDetails)
 import Pages.Internal.Platform.ToJsPayload exposing (ToJsSuccessPayloadNewCombined)
 
@@ -11,4 +12,5 @@ type Effect
     | GetGlob String
     | Batch (List Effect)
     | SendSinglePage Bool ToJsSuccessPayloadNewCombined
+    | SendSinglePageNew Bool Bytes ToJsSuccessPayloadNewCombined
     | Continue

generator/src/Pages/Internal/Platform/ToJsPayload.elm

@@ -1,10 +1,13 @@
 module Pages.Internal.Platform.ToJsPayload exposing
-    ( ToJsSuccessPayloadNew
+    ( NewThing
+    , NewThingForPort
+    , ToJsSuccessPayloadNew
     , ToJsSuccessPayloadNewCombined(..)
     , successCodecNew2
     )
 
 import BuildError exposing (BuildError)
+import Bytes exposing (Bytes)
 import Codec exposing (Codec)
 import Dict exposing (Dict)
 import Head
@@ -46,6 +49,18 @@ errorCodec =
         |> Codec.buildObject
 
 
+type alias NewThing =
+    { oldThing : ToJsSuccessPayloadNew
+    , binaryPageData : Bytes
+    }
+
+
+type alias NewThingForPort =
+    { oldThing : Json.Encode.Value
+    , binaryPageData : Bytes
+    }
+
+
 successCodecNew : String -> String -> Codec ToJsSuccessPayloadNew
 successCodecNew canonicalSiteUrl currentPagePath =
     Codec.object ToJsSuccessPayloadNew

generator/src/dev-server.js

@@ -366,6 +366,14 @@ async function start(options) {
         function (renderResult) {
           const is404 = renderResult.is404;
           switch (renderResult.kind) {
+            case "bytes": {
+              res.writeHead(is404 ? 404 : renderResult.statusCode, {
+                "Content-Type": "application/octet-stream",
+                ...renderResult.headers,
+              });
+              res.end(Buffer.from(renderResult.contentDatPayload.buffer));
+              break;
+            }
             case "json": {
               res.writeHead(is404 ? 404 : renderResult.statusCode, {
                 "Content-Type": "application/json",

generator/src/elm-pages-js-minified.js

@@ -52,7 +52,7 @@ function prefetchIfNeeded(/** @type {HTMLAnchorElement} */ target) {
     link.setAttribute("as", "fetch");
 
     link.setAttribute("rel", "prefetch");
-    link.setAttribute("href", origin + target.pathname + "/content.json");
+    link.setAttribute("href", origin + target.pathname + "/content.dat");
     document.head.appendChild(link);
   }
 }

generator/src/generate-template-module-connector.js

@@ -46,11 +46,13 @@ import Bytes.Decode
 import Bytes.Encode
 import PageServerResponse
 import Pattern
+import Pages.Internal.String
+import Pages.Internal.Platform.ToJsPayload
 import Server.Response
 import ApiRoute
 import Browser.Navigation
 import Route exposing (Route)
-import View
+import Http
 import Json.Decode
 import Json.Encode
 import Pages.Flags
@@ -71,6 +73,9 @@ import Pages.Internal.RoutePattern
 import Url
 import DataSource exposing (DataSource)
 import QueryParams
+import Task exposing (Task)
+import Url exposing (Url)
+import View
 
 ${templates.map((name) => `import Page.${name.join(".")}`).join("\n")}
 
@@ -461,6 +466,91 @@ main =
           .filter((segment) => segment !== "")
           .map((segment) => `"${segment}"`)
           .join(", ")} ]
+        , fetchPageData = fetchPageData
+        , sendPageData = sendPageData
+        , byteEncodePageData = byteEncodePageData
+        }
+
+
+byteEncodePageData : PageData -> Bytes.Encode.Encoder
+byteEncodePageData pageData =
+    case pageData of
+        Data404NotFoundPage____ ->
+            Bytes.Encode.unsignedInt8 0
+
+${templates
+  .map(
+    (name) => `        Data${pathNormalizedName(name)} thisPageData ->
+            Page.${name.join(".")}.w3_encode_Data thisPageData
+`
+  )
+  .join("\n")}
+
+port sendPageData : Pages.Internal.Platform.ToJsPayload.NewThingForPort -> Cmd msg
+
+fetchPageData : Url -> Task Http.Error PageData
+fetchPageData url =
+    Http.task
+        { method = "GET"
+        , headers = []
+        , url =
+            url.path
+                |> Pages.Internal.String.chopForwardSlashes
+                |> String.split "/"
+                |> List.filter ((/=) "")
+                |> (\\l -> l ++ [ "content.dat" ])
+                |> String.join "/"
+                |> String.append "/"
+        , body = Http.emptyBody
+        , resolver =
+            Http.bytesResolver
+                (\\response ->
+                    let
+                        routeThing =
+                            Route.urlToRoute url
+                    in
+                    case response of
+                        Http.BadUrl_ url_ ->
+                            Err (Http.BadUrl url_)
+
+                        Http.Timeout_ ->
+                            Err Http.Timeout
+
+                        Http.NetworkError_ ->
+                            Err Http.NetworkError
+
+                        Http.BadStatus_ metadata _ ->
+                            Err (Http.BadStatus metadata.statusCode)
+
+                        Http.GoodStatus_ _ body ->
+                            let
+                                decoder : Bytes.Decode.Decoder PageData
+                                decoder =
+                                    case routeThing of
+                                        Nothing -> Debug.todo "No route"
+${templates
+  .map(
+    (name) =>
+      `                                        Just (${
+        emptyRouteParams(name)
+          ? `Route.${routeHelpers.routeVariant(name)}`
+          : `(Route.${routeHelpers.routeVariant(name)} routeParams)`
+      }) ->\n                                            Page.${name.join(
+        "."
+      )}.w3_decode_Data |> Bytes.Decode.map Data${routeHelpers.routeVariant(
+        name
+      )}
+
+`
+  )
+  .join("\n")}
+                            in
+                            body
+                                |> decodeBytes decoder
+                                |> Result.mapError
+                                    (\\err -> Http.BadBody err)
+                )
+        , timeout = Nothing
         }
 
 dataForRoute : Maybe Route -> DataSource (Server.Response.Response PageData)

generator/src/render.js

@@ -84,8 +84,11 @@ function runElmApp(
   let app = null;
   let killApp;
   return new Promise((resolve, reject) => {
+    const isBytes = pagePath.match(/content\.dat\/?$/);
     const isJson = pagePath.match(/content\.json\/?$/);
-    const route = pagePath.replace(/content\.json\/?$/, "");
+    const route = pagePath
+      .replace(/content\.json\/?$/, "")
+      .replace(/content\.dat\/?$/, "");
 
     const modifiedRequest = { ...request, path: route };
     // console.log("StaticHttp cache keys", Object.keys(global.staticHttpCache));
@@ -104,12 +107,21 @@ function runElmApp(
 
     killApp = () => {
       app.ports.toJsPort.unsubscribe(portHandler);
+      app.ports.sendPageData.unsubscribe(portHandler);
       app.die();
       app = null;
       // delete require.cache[require.resolve(compiledElmPath)];
     };
 
-    async function portHandler(/** @type { FromElm }  */ fromElm) {
+    async function portHandler(/** @type { FromElm }  */ newThing) {
+      let fromElm;
+      let contentDatPayload;
+      if ("oldThing" in newThing) {
+        fromElm = newThing.oldThing;
+        contentDatPayload = newThing.binaryPageData;
+      } else {
+        fromElm = newThing;
+      }
       if (fromElm.command === "log") {
         console.log(fromElm.value);
       } else if (fromElm.tag === "ApiResponse") {
@@ -130,7 +142,19 @@ function runElmApp(
           global.staticHttpCache = args.staticHttpCache;
         }
 
-        if (isJson) {
+        if (isBytes) {
+          resolve({
+            kind: "bytes",
+            is404: false,
+            contentJson: JSON.stringify({
+              staticData: args.contentJson,
+              is404: false,
+            }),
+            statusCode: args.statusCode,
+            headers: args.headers,
+            contentDatPayload,
+          });
+        } else if (isJson) {
           resolve({
             kind: "json",
             is404: args.is404,
@@ -140,9 +164,12 @@ function runElmApp(
             }),
             statusCode: args.statusCode,
             headers: args.headers,
+            contentDatPayload,
           });
         } else {
-          resolve(outputString(basePath, fromElm, isDevServer));
+          resolve(
+            outputString(basePath, fromElm, isDevServer, contentDatPayload)
+          );
         }
       } else if (fromElm.tag === "ReadFile") {
         const filePath = fromElm.args[0];
@@ -173,6 +200,7 @@ function runElmApp(
       }
     }
     app.ports.toJsPort.subscribe(portHandler);
+    app.ports.sendPageData.subscribe(portHandler);
   }).finally(() => {
     // addDataSourceWatcher(patternsToWatch);
     killApp();
@@ -187,7 +215,8 @@ function runElmApp(
 async function outputString(
   basePath,
   /** @type { PageProgress } */ fromElm,
-  isDevServer
+  isDevServer,
+  contentDatPayload
 ) {
   const args = fromElm.args[0];
   let contentJson = {};

generator/static-code/elm-pages.js

@@ -54,7 +54,7 @@ function prefetchIfNeeded(/** @type {HTMLAnchorElement} */ target) {
     link.setAttribute("as", "fetch");
 
     link.setAttribute("rel", "prefetch");
-    link.setAttribute("href", origin + target.pathname + "/content.json");
+    link.setAttribute("href", origin + target.pathname + "/content.dat");
     document.head.appendChild(link);
   }
 }

src/Pages/ProgramConfig.elm

@@ -2,18 +2,22 @@ module Pages.ProgramConfig exposing (ProgramConfig)
 
 import ApiRoute
 import Browser.Navigation
+import Bytes.Encode
 import DataSource
 import Head
 import Html exposing (Html)
+import Http
 import Json.Decode as Decode
 import Json.Encode
 import PageServerResponse exposing (PageServerResponse)
 import Pages.Flags
 import Pages.Internal.NotFoundReason exposing (NotFoundReason)
+import Pages.Internal.Platform.ToJsPayload
 import Pages.Internal.RoutePattern exposing (RoutePattern)
 import Pages.PageUrl exposing (PageUrl)
 import Pages.SiteConfig exposing (SiteConfig)
 import Path exposing (Path)
+import Task exposing (Task)
 import Url exposing (Url)
 
 
@@ -71,4 +75,7 @@ type alias ProgramConfig userMsg userModel route siteData pageData sharedData =
         -> List (ApiRoute.ApiRoute ApiRoute.Response)
     , pathPatterns : List RoutePattern
     , basePath : List String
+    , fetchPageData : Url -> Task Http.Error pageData
+    , sendPageData : Pages.Internal.Platform.ToJsPayload.NewThingForPort -> Cmd Never
+    , byteEncodePageData : pageData -> Bytes.Encode.Encoder
     }