elm-pages 3.0.0-beta.3 → 3.0.0-beta.31

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
Files changed (129) hide show
  1. package/README.md +10 -1
  2. package/codegen/{elm-pages-codegen.js → elm-pages-codegen.cjs} +2864 -2589
  3. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Review-DeadCodeEliminateData.elmi +0 -0
  4. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Review-DeadCodeEliminateData.elmo +0 -0
  5. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Review-DeadCodeEliminateDataTest.elmo +0 -0
  6. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/d.dat +0 -0
  7. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/i.dat +0 -0
  8. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/o.dat +0 -0
  9. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm.json +1 -1
  10. package/generator/dead-code-review/elm-stuff/tests-0.19.1/js/Reporter.elm.js +1447 -342
  11. package/generator/dead-code-review/elm-stuff/tests-0.19.1/js/Runner.elm.js +16458 -13724
  12. package/generator/dead-code-review/elm-stuff/tests-0.19.1/js/node_runner.js +1 -1
  13. package/generator/dead-code-review/elm-stuff/tests-0.19.1/js/node_supervisor.js +4 -4
  14. package/generator/dead-code-review/elm.json +9 -7
  15. package/generator/dead-code-review/src/Pages/Review/DeadCodeEliminateData.elm +59 -10
  16. package/generator/dead-code-review/tests/Pages/Review/DeadCodeEliminateDataTest.elm +52 -36
  17. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Internal-RoutePattern.elmi +0 -0
  18. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Internal-RoutePattern.elmo +0 -0
  19. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Review-NoContractViolations.elmi +0 -0
  20. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Review-NoContractViolations.elmo +0 -0
  21. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/d.dat +0 -0
  22. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/i.dat +0 -0
  23. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/o.dat +0 -0
  24. package/generator/review/elm-stuff/tests-0.19.1/elm.json +1 -1
  25. package/generator/review/elm-stuff/tests-0.19.1/js/Reporter.elm.js +1447 -342
  26. package/generator/review/elm-stuff/tests-0.19.1/js/Runner.elm.js +24542 -21748
  27. package/generator/review/elm-stuff/tests-0.19.1/js/node_runner.js +1 -1
  28. package/generator/review/elm-stuff/tests-0.19.1/js/node_supervisor.js +4 -4
  29. package/generator/review/elm.json +10 -10
  30. package/generator/src/RouteBuilder.elm +113 -107
  31. package/generator/src/SharedTemplate.elm +3 -2
  32. package/generator/src/SiteConfig.elm +3 -2
  33. package/generator/src/basepath-middleware.js +3 -3
  34. package/generator/src/build.js +125 -88
  35. package/generator/src/cli.js +273 -88
  36. package/generator/src/codegen.js +29 -27
  37. package/generator/src/compatibility-key.js +3 -0
  38. package/generator/src/compile-elm.js +43 -26
  39. package/generator/src/config.js +39 -0
  40. package/generator/src/copy-dir.js +2 -2
  41. package/generator/src/dev-server.js +150 -133
  42. package/generator/src/dir-helpers.js +9 -26
  43. package/generator/src/elm-codegen.js +5 -4
  44. package/generator/src/elm-file-constants.js +2 -3
  45. package/generator/src/error-formatter.js +12 -11
  46. package/generator/src/file-helpers.js +3 -4
  47. package/generator/src/generate-template-module-connector.js +23 -22
  48. package/generator/src/init.js +9 -8
  49. package/generator/src/pre-render-html.js +39 -28
  50. package/generator/src/render-test.js +109 -0
  51. package/generator/src/render-worker.js +25 -28
  52. package/generator/src/render.js +320 -142
  53. package/generator/src/request-cache.js +252 -163
  54. package/generator/src/resolve-elm-module.js +63 -0
  55. package/generator/src/rewrite-client-elm-json.js +6 -5
  56. package/generator/src/rewrite-elm-json-help.js +56 -0
  57. package/generator/src/rewrite-elm-json.js +17 -7
  58. package/generator/src/route-codegen-helpers.js +16 -31
  59. package/generator/src/seo-renderer.js +12 -7
  60. package/generator/src/vite-utils.js +77 -0
  61. package/generator/static-code/hmr.js +79 -13
  62. package/generator/template/app/Api.elm +6 -5
  63. package/generator/template/app/Effect.elm +123 -0
  64. package/generator/template/app/ErrorPage.elm +37 -6
  65. package/generator/template/app/Route/Index.elm +17 -10
  66. package/generator/template/app/Shared.elm +24 -47
  67. package/generator/template/app/Site.elm +19 -6
  68. package/generator/template/app/View.elm +1 -8
  69. package/generator/template/elm-tooling.json +0 -3
  70. package/generator/template/elm.json +32 -24
  71. package/generator/template/package.json +10 -4
  72. package/package.json +29 -27
  73. package/src/ApiRoute.elm +199 -61
  74. package/src/BackendTask/Custom.elm +325 -0
  75. package/src/BackendTask/Env.elm +90 -0
  76. package/src/{DataSource → BackendTask}/File.elm +128 -43
  77. package/src/{DataSource → BackendTask}/Glob.elm +136 -125
  78. package/src/BackendTask/Http.elm +673 -0
  79. package/src/{DataSource → BackendTask}/Internal/Glob.elm +1 -1
  80. package/src/BackendTask/Internal/Request.elm +28 -0
  81. package/src/BackendTask/Random.elm +79 -0
  82. package/src/BackendTask/Time.elm +47 -0
  83. package/src/BackendTask.elm +537 -0
  84. package/src/FatalError.elm +89 -0
  85. package/src/Form/Field.elm +21 -9
  86. package/src/Form/FieldView.elm +94 -14
  87. package/src/Form.elm +275 -400
  88. package/src/Head.elm +237 -7
  89. package/src/HtmlPrinter.elm +7 -3
  90. package/src/Internal/ApiRoute.elm +7 -5
  91. package/src/PageServerResponse.elm +6 -1
  92. package/src/Pages/FormState.elm +6 -5
  93. package/src/Pages/GeneratorProgramConfig.elm +15 -0
  94. package/src/Pages/Internal/FatalError.elm +5 -0
  95. package/src/Pages/Internal/Form.elm +21 -1
  96. package/src/Pages/{Msg.elm → Internal/Msg.elm} +26 -16
  97. package/src/Pages/Internal/Platform/Cli.elm +598 -763
  98. package/src/Pages/Internal/Platform/CompatibilityKey.elm +6 -0
  99. package/src/Pages/Internal/Platform/Effect.elm +1 -2
  100. package/src/Pages/Internal/Platform/GeneratorApplication.elm +373 -0
  101. package/src/Pages/Internal/Platform/StaticResponses.elm +73 -270
  102. package/src/Pages/Internal/Platform/ToJsPayload.elm +4 -7
  103. package/src/Pages/Internal/Platform.elm +216 -102
  104. package/src/Pages/Internal/Script.elm +17 -0
  105. package/src/Pages/Internal/StaticHttpBody.elm +35 -1
  106. package/src/Pages/Manifest.elm +29 -4
  107. package/src/Pages/PageUrl.elm +23 -9
  108. package/src/Pages/ProgramConfig.elm +14 -10
  109. package/src/Pages/Script.elm +109 -0
  110. package/src/Pages/SiteConfig.elm +3 -2
  111. package/src/Pages/StaticHttp/Request.elm +2 -2
  112. package/src/Pages/StaticHttpRequest.elm +23 -98
  113. package/src/PagesMsg.elm +92 -0
  114. package/src/Path.elm +16 -19
  115. package/src/QueryParams.elm +21 -172
  116. package/src/RequestsAndPending.elm +8 -19
  117. package/src/Result/Extra.elm +26 -0
  118. package/src/Scaffold/Form.elm +560 -0
  119. package/src/Scaffold/Route.elm +1388 -0
  120. package/src/Server/Request.elm +43 -37
  121. package/src/Server/Session.elm +62 -42
  122. package/src/Server/SetCookie.elm +12 -4
  123. package/src/Test/Html/Internal/ElmHtml/ToString.elm +8 -9
  124. package/src/DataSource/Env.elm +0 -38
  125. package/src/DataSource/Http.elm +0 -446
  126. package/src/DataSource/Internal/Request.elm +0 -20
  127. package/src/DataSource/Port.elm +0 -90
  128. package/src/DataSource.elm +0 -538
  129. package/src/Pages/Generate.elm +0 -800
@@ -1,19 +1,19 @@
1
- module Pages.Internal.Platform.Cli exposing (Flags, Model, Msg(..), Program, cliApplication, init, requestDecoder, update)
1
+ module Pages.Internal.Platform.Cli exposing (Flags, Model, Msg(..), Program, cliApplication, init, requestDecoder, update, currentCompatibilityKey)
2
2
 
3
3
  {-| Exposed for internal use only (used in generated code).
4
4
 
5
- @docs Flags, Model, Msg, Program, cliApplication, init, requestDecoder, update
5
+ @docs Flags, Model, Msg, Program, cliApplication, init, requestDecoder, update, currentCompatibilityKey
6
6
 
7
7
  -}
8
8
 
9
- import ApiRoute
9
+ import BackendTask exposing (BackendTask)
10
10
  import BuildError exposing (BuildError)
11
11
  import Bytes exposing (Bytes)
12
12
  import Bytes.Encode
13
13
  import Codec
14
- import DataSource exposing (DataSource)
15
14
  import Dict
16
- import Head
15
+ import FatalError exposing (FatalError)
16
+ import Head exposing (Tag)
17
17
  import Html exposing (Html)
18
18
  import HtmlPrinter
19
19
  import Internal.ApiRoute exposing (ApiRoute(..))
@@ -21,22 +21,20 @@ import Json.Decode as Decode
21
21
  import Json.Encode
22
22
  import PageServerResponse exposing (PageServerResponse)
23
23
  import Pages.Flags
24
- import Pages.Http
24
+ import Pages.Internal.FatalError
25
25
  import Pages.Internal.NotFoundReason as NotFoundReason exposing (NotFoundReason)
26
+ import Pages.Internal.Platform.CompatibilityKey
26
27
  import Pages.Internal.Platform.Effect as Effect exposing (Effect)
27
- import Pages.Internal.Platform.StaticResponses as StaticResponses exposing (StaticResponses)
28
+ import Pages.Internal.Platform.StaticResponses as StaticResponses
28
29
  import Pages.Internal.Platform.ToJsPayload as ToJsPayload
29
30
  import Pages.Internal.ResponseSketch as ResponseSketch
30
- import Pages.Internal.StaticHttpBody as StaticHttpBody
31
- import Pages.Msg
32
31
  import Pages.ProgramConfig exposing (ProgramConfig)
33
32
  import Pages.SiteConfig exposing (SiteConfig)
34
33
  import Pages.StaticHttp.Request
35
- import Pages.StaticHttpRequest as StaticHttpRequest
34
+ import PagesMsg exposing (PagesMsg)
36
35
  import Path exposing (Path)
37
36
  import RenderRequest exposing (RenderRequest)
38
37
  import RequestsAndPending exposing (RequestsAndPending)
39
- import Task
40
38
  import TerminalText as Terminal
41
39
  import Url exposing (Url)
42
40
 
@@ -46,12 +44,16 @@ type alias Flags =
46
44
  Decode.Value
47
45
 
48
46
 
47
+ {-| -}
48
+ currentCompatibilityKey : Int
49
+ currentCompatibilityKey =
50
+ Pages.Internal.Platform.CompatibilityKey.currentCompatibilityKey
51
+
52
+
49
53
  {-| -}
50
54
  type alias Model route =
51
- { staticResponses : StaticResponses
55
+ { staticResponses : BackendTask FatalError Effect
52
56
  , errors : List BuildError
53
- , allRawResponses : RequestsAndPending
54
- , unprocessedPages : List ( Path, route )
55
57
  , maybeRequestJson : RenderRequest route
56
58
  , isDevServer : Bool
57
59
  }
@@ -59,12 +61,7 @@ type alias Model route =
59
61
 
60
62
  {-| -}
61
63
  type Msg
62
- = GotDataBatch
63
- (List
64
- { request : Pages.StaticHttp.Request.Request
65
- , response : RequestsAndPending.Response
66
- }
67
- )
64
+ = GotDataBatch Decode.Value
68
65
  | GotBuildError BuildError
69
66
 
70
67
 
@@ -105,7 +102,7 @@ cliApplication config =
105
102
  |> Tuple.mapSecond (perform site renderRequest config)
106
103
  , update =
107
104
  \msg model ->
108
- update site config msg model
105
+ update msg model
109
106
  |> Tuple.mapSecond (perform site model.maybeRequestJson config)
110
107
  , subscriptions =
111
108
  \_ ->
@@ -152,35 +149,11 @@ cliApplication config =
152
149
  )
153
150
  |> mergeResult
154
151
  )
155
- , config.gotBatchSub
156
- |> Sub.map
157
- (\newBatch ->
158
- Decode.decodeValue batchDecoder newBatch
159
- |> Result.map GotDataBatch
160
- |> Result.mapError
161
- (\error ->
162
- ("From location 2: "
163
- ++ (error
164
- |> Decode.errorToString
165
- )
166
- )
167
- |> BuildError.internal
168
- |> GotBuildError
169
- )
170
- |> mergeResult
171
- )
152
+ , config.gotBatchSub |> Sub.map GotDataBatch
172
153
  ]
173
154
  }
174
155
 
175
156
 
176
- batchDecoder : Decode.Decoder (List { request : Pages.StaticHttp.Request.Request, response : RequestsAndPending.Response })
177
- batchDecoder =
178
- Decode.map2 (\request response -> { request = request, response = response })
179
- (Decode.field "request" requestDecoder)
180
- (Decode.field "response" RequestsAndPending.decoder)
181
- |> Decode.list
182
-
183
-
184
157
  mergeResult : Result a a -> a
185
158
  mergeResult r =
186
159
  case r of
@@ -237,61 +210,16 @@ perform site renderRequest config effect =
237
210
  Effect.Batch list ->
238
211
  flatten site renderRequest config list
239
212
 
240
- Effect.FetchHttp unmasked ->
241
- if unmasked.url == "$$elm-pages$$headers" then
242
- case
243
- renderRequest
244
- |> RenderRequest.maybeRequestPayload
245
- |> Maybe.map (\json -> RequestsAndPending.Response Nothing (RequestsAndPending.JsonBody json))
246
- |> Result.fromMaybe (Pages.Http.BadUrl "$$elm-pages$$headers is only available on server-side request (not on build).")
247
- of
248
- Ok okResponse ->
249
- Task.succeed
250
- [ { request = unmasked
251
- , response = okResponse
252
- }
253
- ]
254
- |> Task.perform GotDataBatch
255
-
256
- Err error ->
257
- { title = "Static HTTP Error"
258
- , message =
259
- [ Terminal.text "I got an error making an HTTP request to this URL: "
260
-
261
- -- TODO include HTTP method, headers, and body
262
- , Terminal.yellow unmasked.url
263
- , Terminal.text <| Json.Encode.encode 2 <| StaticHttpBody.encode unmasked.body
264
- , Terminal.text "\n\n"
265
- , case error of
266
- Pages.Http.BadStatus metadata body ->
267
- Terminal.text <|
268
- String.join "\n"
269
- [ "Bad status: " ++ String.fromInt metadata.statusCode
270
- , "Status message: " ++ metadata.statusText
271
- , "Body: " ++ body
272
- ]
273
-
274
- Pages.Http.BadUrl _ ->
275
- -- TODO include HTTP method, headers, and body
276
- Terminal.text <| "Invalid url: " ++ unmasked.url
277
-
278
- Pages.Http.Timeout ->
279
- Terminal.text "Timeout"
280
-
281
- Pages.Http.NetworkError ->
282
- Terminal.text "Network error"
283
- ]
284
- , fatal = True
285
- , path = "" -- TODO wire in current path here
286
- }
287
- |> Task.succeed
288
- |> Task.perform GotBuildError
289
-
290
- else
291
- ToJsPayload.DoHttp unmasked unmasked.useCache
292
- |> Codec.encoder (ToJsPayload.successCodecNew2 canonicalSiteUrl "")
293
- |> config.toJsPort
294
- |> Cmd.map never
213
+ Effect.FetchHttp requests ->
214
+ requests
215
+ |> List.map
216
+ (\request ->
217
+ ( Pages.StaticHttp.Request.hash request, request )
218
+ )
219
+ |> ToJsPayload.DoHttp
220
+ |> Codec.encoder (ToJsPayload.successCodecNew2 canonicalSiteUrl "")
221
+ |> config.toJsPort
222
+ |> Cmd.map never
295
223
 
296
224
  Effect.SendSinglePage info ->
297
225
  let
@@ -328,32 +256,25 @@ perform site renderRequest config effect =
328
256
  |> config.sendPageData
329
257
  |> Cmd.map never
330
258
 
331
- Effect.Continue ->
332
- Cmd.none
333
-
334
259
 
335
260
  flagsDecoder :
336
261
  Decode.Decoder
337
262
  { staticHttpCache : RequestsAndPending
338
263
  , isDevServer : Bool
264
+ , compatibilityKey : Int
339
265
  }
340
266
  flagsDecoder =
341
- Decode.map2
342
- (\staticHttpCache isDevServer ->
267
+ Decode.map3
268
+ (\staticHttpCache isDevServer compatibilityKey ->
343
269
  { staticHttpCache = staticHttpCache
344
270
  , isDevServer = isDevServer
271
+ , compatibilityKey = compatibilityKey
345
272
  }
346
273
  )
347
- --(Decode.field "staticHttpCache"
348
- -- (Decode.dict
349
- -- (Decode.string
350
- -- |> Decode.map Just
351
- -- )
352
- -- )
353
- --)
354
274
  -- TODO remove hardcoding and decode staticHttpCache here
355
- (Decode.succeed Dict.empty)
275
+ (Decode.succeed (Json.Encode.object []))
356
276
  (Decode.field "mode" Decode.string |> Decode.map (\mode -> mode == "dev-server"))
277
+ (Decode.field "compatibilityKey" Decode.int)
357
278
 
358
279
 
359
280
  {-| -}
@@ -365,14 +286,42 @@ init :
365
286
  -> ( Model route, Effect )
366
287
  init site renderRequest config flags =
367
288
  case Decode.decodeValue flagsDecoder flags of
368
- Ok { staticHttpCache, isDevServer } ->
369
- initLegacy site renderRequest { staticHttpCache = staticHttpCache, isDevServer = isDevServer } config
289
+ Ok { isDevServer, compatibilityKey } ->
290
+ if compatibilityKey == currentCompatibilityKey then
291
+ initLegacy site renderRequest { isDevServer = isDevServer } config
292
+
293
+ else
294
+ let
295
+ elmPackageAheadOfNpmPackage : Bool
296
+ elmPackageAheadOfNpmPackage =
297
+ currentCompatibilityKey > compatibilityKey
298
+
299
+ message : String
300
+ message =
301
+ "The NPM package and Elm package you have installed are incompatible. If you are updating versions, be sure to update both the elm-pages Elm and NPM package.\n\n"
302
+ ++ (if elmPackageAheadOfNpmPackage then
303
+ "The elm-pages Elm package is ahead of the elm-pages NPM package. Try updating the elm-pages NPM package?"
304
+
305
+ else
306
+ "The elm-pages NPM package is ahead of the elm-pages Elm package. Try updating the elm-pages Elm package?"
307
+ )
308
+ in
309
+ updateAndSendPortIfDone
310
+ { staticResponses = StaticResponses.empty Effect.NoEffect
311
+ , errors =
312
+ [ { title = "Incompatible NPM and Elm package versions"
313
+ , message = [ Terminal.text <| message ]
314
+ , fatal = True
315
+ , path = ""
316
+ }
317
+ ]
318
+ , maybeRequestJson = renderRequest
319
+ , isDevServer = False
320
+ }
370
321
 
371
322
  Err error ->
372
323
  updateAndSendPortIfDone
373
- site
374
- config
375
- { staticResponses = StaticResponses.empty
324
+ { staticResponses = StaticResponses.empty Effect.NoEffect
376
325
  , errors =
377
326
  [ { title = "Internal Error"
378
327
  , message = [ Terminal.text <| "Failed to parse flags: " ++ Decode.errorToString error ]
@@ -380,8 +329,6 @@ init site renderRequest config flags =
380
329
  , path = ""
381
330
  }
382
331
  ]
383
- , allRawResponses = Dict.empty
384
- , unprocessedPages = []
385
332
  , maybeRequestJson = renderRequest
386
333
  , isDevServer = False
387
334
  }
@@ -430,140 +377,495 @@ isActionDecoder =
430
377
  initLegacy :
431
378
  SiteConfig
432
379
  -> RenderRequest route
433
- -> { staticHttpCache : RequestsAndPending, isDevServer : Bool }
380
+ -> { isDevServer : Bool }
434
381
  -> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
435
382
  -> ( Model route, Effect )
436
- initLegacy site renderRequest { staticHttpCache, isDevServer } config =
383
+ initLegacy site ((RenderRequest.SinglePage includeHtml singleRequest _) as renderRequest) { isDevServer } config =
437
384
  let
438
- staticResponses : StaticResponses
439
- staticResponses =
440
- case renderRequest of
441
- RenderRequest.SinglePage _ singleRequest _ ->
442
- let
443
- globalHeadTags : DataSource (List Head.Tag)
444
- globalHeadTags =
445
- (config.globalHeadTags |> Maybe.withDefault (\_ -> DataSource.succeed [])) HtmlPrinter.htmlToString
446
- in
447
- case singleRequest of
448
- RenderRequest.Page serverRequestPayload ->
449
- let
450
- isAction : Maybe ActionRequest
451
- isAction =
452
- renderRequest
453
- |> RenderRequest.maybeRequestPayload
454
- |> Maybe.andThen (Decode.decodeValue isActionDecoder >> Result.withDefault Nothing)
455
- in
456
- StaticResponses.renderSingleRoute
457
- (case isAction of
458
- Just _ ->
459
- config.action serverRequestPayload.frontmatter
460
- |> DataSource.andThen
461
- (\something ->
462
- case something of
463
- PageServerResponse.ErrorPage _ _ ->
464
- DataSource.succeed something
465
- |> DataSource.map (\_ -> ())
466
-
467
- PageServerResponse.RenderPage _ _ ->
468
- DataSource.map3 (\_ _ _ -> ())
469
- (config.data serverRequestPayload.frontmatter)
470
- config.sharedData
471
- globalHeadTags
472
-
473
- PageServerResponse.ServerResponse _ ->
474
- DataSource.succeed something
475
- |> DataSource.map (\_ -> ())
476
- )
385
+ globalHeadTags : BackendTask FatalError (List Tag)
386
+ globalHeadTags =
387
+ (config.globalHeadTags |> Maybe.withDefault (\_ -> BackendTask.succeed [])) HtmlPrinter.htmlToString
388
+
389
+ staticResponsesNew : BackendTask FatalError Effect
390
+ staticResponsesNew =
391
+ StaticResponses.renderApiRequest
392
+ (case singleRequest of
393
+ RenderRequest.Page serverRequestPayload ->
394
+ let
395
+ isAction : Maybe ActionRequest
396
+ isAction =
397
+ renderRequest
398
+ |> RenderRequest.maybeRequestPayload
399
+ |> Maybe.andThen (Decode.decodeValue isActionDecoder >> Result.withDefault Nothing)
400
+
401
+ currentUrl : Url
402
+ currentUrl =
403
+ { protocol = Url.Https
404
+ , host = site.canonicalUrl
405
+ , port_ = Nothing
406
+ , path = serverRequestPayload.path |> Path.toRelative
407
+ , query = Nothing
408
+ , fragment = Nothing
409
+ }
410
+ in
411
+ --case isAction of
412
+ -- Just actionRequest ->
413
+ (if isDevServer then
414
+ config.handleRoute serverRequestPayload.frontmatter
477
415
 
478
- Nothing ->
479
- DataSource.map3 (\_ _ _ -> ())
480
- (config.data serverRequestPayload.frontmatter)
481
- config.sharedData
482
- globalHeadTags
483
- )
484
- (if isDevServer then
485
- config.handleRoute serverRequestPayload.frontmatter
416
+ else
417
+ BackendTask.succeed Nothing
418
+ )
419
+ |> BackendTask.andThen
420
+ (\pageFound ->
421
+ case pageFound of
422
+ Nothing ->
423
+ --sendSinglePageProgress site model.allRawResponses config model payload
424
+ (case isAction of
425
+ Just _ ->
426
+ config.action (RenderRequest.maybeRequestPayload renderRequest |> Maybe.withDefault Json.Encode.null) serverRequestPayload.frontmatter |> BackendTask.map Just
427
+
428
+ Nothing ->
429
+ BackendTask.succeed Nothing
430
+ )
431
+ |> BackendTask.andThen
432
+ (\something ->
433
+ let
434
+ actionHeaders2 : Maybe { statusCode : Int, headers : List ( String, String ) }
435
+ actionHeaders2 =
436
+ case something of
437
+ Just (PageServerResponse.RenderPage responseThing _) ->
438
+ Just responseThing
439
+
440
+ Just (PageServerResponse.ServerResponse responseThing) ->
441
+ Just
442
+ { headers = responseThing.headers
443
+ , statusCode = responseThing.statusCode
444
+ }
486
445
 
487
- else
488
- DataSource.succeed Nothing
489
- )
446
+ _ ->
447
+ Nothing
490
448
 
491
- RenderRequest.Api ( path, ApiRoute apiRequest ) ->
492
- StaticResponses.renderApiRequest
493
- (DataSource.map2 (\_ _ -> ())
494
- (apiRequest.matchesToResponse path)
495
- globalHeadTags
496
- )
449
+ maybeRedirectResponse : Maybe Effect
450
+ maybeRedirectResponse =
451
+ actionHeaders2
452
+ |> Maybe.andThen
453
+ (\responseMetadata ->
454
+ toRedirectResponse config
455
+ serverRequestPayload
456
+ includeHtml
457
+ responseMetadata
458
+ responseMetadata
459
+ )
460
+ in
461
+ case maybeRedirectResponse of
462
+ Just redirectResponse ->
463
+ redirectResponse
464
+ |> BackendTask.succeed
497
465
 
498
- RenderRequest.NotFound _ ->
499
- StaticResponses.renderApiRequest
500
- (DataSource.map2 (\_ _ -> ())
501
- (DataSource.succeed [])
502
- globalHeadTags
503
- )
466
+ Nothing ->
467
+ BackendTask.map3
468
+ (\pageData sharedData tags ->
469
+ let
470
+ renderedResult : Effect
471
+ renderedResult =
472
+ case pageData of
473
+ PageServerResponse.RenderPage responseInfo pageData_ ->
474
+ let
475
+ currentPage : { path : Path, route : route }
476
+ currentPage =
477
+ { path = serverRequestPayload.path, route = urlToRoute config currentUrl }
478
+
479
+ maybeActionData : Maybe actionData
480
+ maybeActionData =
481
+ case something of
482
+ Just (PageServerResponse.RenderPage _ actionThing) ->
483
+ Just actionThing
484
+
485
+ _ ->
486
+ Nothing
487
+
488
+ pageModel : userModel
489
+ pageModel =
490
+ config.init
491
+ Pages.Flags.PreRenderFlags
492
+ sharedData
493
+ pageData_
494
+ maybeActionData
495
+ (Just
496
+ { path =
497
+ { path = currentPage.path
498
+ , query = Nothing
499
+ , fragment = Nothing
500
+ }
501
+ , metadata = currentPage.route
502
+ , pageUrl = Nothing
503
+ }
504
+ )
505
+ |> Tuple.first
506
+
507
+ viewValue : { title : String, body : List (Html (PagesMsg userMsg)) }
508
+ viewValue =
509
+ (config.view Dict.empty Dict.empty Nothing currentPage Nothing sharedData pageData_ maybeActionData |> .view) pageModel
510
+
511
+ responseMetadata : { statusCode : Int, headers : List ( String, String ) }
512
+ responseMetadata =
513
+ actionHeaders2 |> Maybe.withDefault responseInfo
514
+ in
515
+ (case isAction of
516
+ Just actionRequestKind ->
517
+ let
518
+ actionDataResult : Maybe (PageServerResponse actionData errorPage)
519
+ actionDataResult =
520
+ something
521
+ in
522
+ case actionDataResult of
523
+ Just (PageServerResponse.RenderPage ignored2 actionData_) ->
524
+ case actionRequestKind of
525
+ ActionResponseRequest ->
526
+ ( ignored2.headers
527
+ , ResponseSketch.HotUpdate pageData_ sharedData (Just actionData_)
528
+ |> config.encodeResponse
529
+ |> Bytes.Encode.encode
530
+ )
531
+
532
+ ActionOnlyRequest ->
533
+ ---- TODO need to encode action data when only that is requested (not ResponseSketch?)
534
+ ( ignored2.headers
535
+ , actionData_
536
+ |> config.encodeAction
537
+ |> Bytes.Encode.encode
538
+ )
539
+
540
+ _ ->
541
+ ( responseMetadata.headers
542
+ , Bytes.Encode.encode (Bytes.Encode.unsignedInt8 0)
543
+ )
544
+
545
+ Nothing ->
546
+ ( responseMetadata.headers
547
+ , ResponseSketch.HotUpdate pageData_ sharedData Nothing
548
+ |> config.encodeResponse
549
+ |> Bytes.Encode.encode
550
+ )
551
+ )
552
+ |> (\( actionHeaders, byteEncodedPageData ) ->
553
+ let
554
+ rendered : { view : userModel -> { title : String, body : List (Html (PagesMsg userMsg)) }, head : List Tag }
555
+ rendered =
556
+ config.view Dict.empty Dict.empty Nothing currentPage Nothing sharedData pageData_ maybeActionData
557
+ in
558
+ PageServerResponse.toRedirect responseMetadata
559
+ |> Maybe.map
560
+ (\{ location } ->
561
+ location
562
+ |> ResponseSketch.Redirect
563
+ |> config.encodeResponse
564
+ |> Bytes.Encode.encode
565
+ )
566
+ -- TODO handle other cases besides redirects?
567
+ |> Maybe.withDefault byteEncodedPageData
568
+ |> (\encodedData ->
569
+ { route = currentPage.path |> Path.toRelative
570
+ , contentJson = Dict.empty
571
+ , html = viewValue.body |> bodyToString
572
+ , errors = []
573
+ , head = rendered.head ++ tags
574
+ , title = viewValue.title
575
+ , staticHttpCache = Dict.empty
576
+ , is404 = False
577
+ , statusCode =
578
+ case includeHtml of
579
+ RenderRequest.OnlyJson ->
580
+ 200
581
+
582
+ RenderRequest.HtmlAndJson ->
583
+ responseMetadata.statusCode
584
+ , headers =
585
+ -- TODO should `responseInfo.headers` be used? Is there a problem in the case where there is both an action and data response in one? Do we need to make sure it is performed as two separate HTTP requests to ensure that the cookies are set correctly in that case?
586
+ actionHeaders
587
+ }
588
+ |> ToJsPayload.PageProgress
589
+ |> Effect.SendSinglePageNew encodedData
590
+ )
591
+ )
592
+
593
+ PageServerResponse.ServerResponse serverResponse ->
594
+ --PageServerResponse.ServerResponse serverResponse
595
+ -- TODO handle error?
596
+ let
597
+ responseMetadata : PageServerResponse.Response
598
+ responseMetadata =
599
+ case something of
600
+ Just (PageServerResponse.ServerResponse responseThing) ->
601
+ responseThing
602
+
603
+ _ ->
604
+ serverResponse
605
+ in
606
+ toRedirectResponse config serverRequestPayload includeHtml serverResponse responseMetadata
607
+ |> Maybe.withDefault
608
+ ({ body = serverResponse |> PageServerResponse.toJson
609
+ , staticHttpCache = Dict.empty
610
+ , statusCode = serverResponse.statusCode
611
+ }
612
+ |> ToJsPayload.SendApiResponse
613
+ |> Effect.SendSinglePage
614
+ )
615
+
616
+ PageServerResponse.ErrorPage error record ->
617
+ let
618
+ currentPage : { path : Path, route : route }
619
+ currentPage =
620
+ { path = serverRequestPayload.path, route = urlToRoute config currentUrl }
621
+
622
+ pageModel : userModel
623
+ pageModel =
624
+ config.init
625
+ Pages.Flags.PreRenderFlags
626
+ sharedData
627
+ pageData2
628
+ Nothing
629
+ (Just
630
+ { path =
631
+ { path = currentPage.path
632
+ , query = Nothing
633
+ , fragment = Nothing
634
+ }
635
+ , metadata = currentPage.route
636
+ , pageUrl = Nothing
637
+ }
638
+ )
639
+ |> Tuple.first
640
+
641
+ pageData2 : pageData
642
+ pageData2 =
643
+ config.errorPageToData error
644
+
645
+ viewValue : { title : String, body : List (Html (PagesMsg userMsg)) }
646
+ viewValue =
647
+ (config.view Dict.empty Dict.empty Nothing currentPage Nothing sharedData pageData2 Nothing |> .view) pageModel
648
+ in
649
+ (ResponseSketch.HotUpdate pageData2 sharedData Nothing
650
+ |> config.encodeResponse
651
+ |> Bytes.Encode.encode
652
+ )
653
+ |> (\encodedData ->
654
+ { route = currentPage.path |> Path.toRelative
655
+ , contentJson = Dict.empty
656
+ , html = viewValue.body |> bodyToString
657
+ , errors = []
658
+ , head = tags
659
+ , title = viewValue.title
660
+ , staticHttpCache = Dict.empty
661
+ , is404 = False
662
+ , statusCode =
663
+ case includeHtml of
664
+ RenderRequest.OnlyJson ->
665
+ 200
666
+
667
+ RenderRequest.HtmlAndJson ->
668
+ config.errorStatusCode error
669
+ , headers = record.headers
670
+ }
671
+ |> ToJsPayload.PageProgress
672
+ |> Effect.SendSinglePageNew encodedData
673
+ )
674
+ in
675
+ renderedResult
676
+ )
677
+ (config.data (RenderRequest.maybeRequestPayload renderRequest |> Maybe.withDefault Json.Encode.null) serverRequestPayload.frontmatter)
678
+ config.sharedData
679
+ globalHeadTags
680
+ )
681
+ |> BackendTask.onError
682
+ (\((Pages.Internal.FatalError.FatalError fatalError) as error) ->
683
+ let
684
+ isPreRendered : Bool
685
+ isPreRendered =
686
+ let
687
+ keys : Int
688
+ keys =
689
+ RenderRequest.maybeRequestPayload renderRequest |> Maybe.map (Decode.decodeValue (Decode.keyValuePairs Decode.value)) |> Maybe.withDefault (Ok []) |> Result.withDefault [] |> List.map Tuple.first |> List.length
690
+ in
691
+ -- TODO this is a bit hacky, would be nice to clean up the way of checking whether this is server-rendered or pre-rendered
692
+ keys <= 1
693
+ in
694
+ if isDevServer || isPreRendered then
695
+ -- we want to stop the build for pre-rendered routes, and give a dev server error popup in the dev server
696
+ BackendTask.fail error
697
+
698
+ else
699
+ --only render the production ErrorPage in production server-rendered Routes
700
+ config.sharedData
701
+ |> BackendTask.andThen
702
+ (\justSharedData ->
703
+ let
704
+ errorPage : errorPage
705
+ errorPage =
706
+ config.internalError fatalError.body
707
+
708
+ dataThing : pageData
709
+ dataThing =
710
+ errorPage
711
+ |> config.errorPageToData
712
+
713
+ statusCode : Int
714
+ statusCode =
715
+ config.errorStatusCode errorPage
716
+
717
+ byteEncodedPageData : Bytes
718
+ byteEncodedPageData =
719
+ ResponseSketch.HotUpdate
720
+ dataThing
721
+ justSharedData
722
+ -- TODO remove shared action data
723
+ Nothing
724
+ |> config.encodeResponse
725
+ |> Bytes.Encode.encode
726
+
727
+ pageModel : userModel
728
+ pageModel =
729
+ config.init
730
+ Pages.Flags.PreRenderFlags
731
+ justSharedData
732
+ dataThing
733
+ Nothing
734
+ (Just
735
+ { path =
736
+ { path = currentPage.path
737
+ , query = Nothing
738
+ , fragment = Nothing
739
+ }
740
+ , metadata = currentPage.route
741
+ , pageUrl = Nothing
742
+ }
743
+ )
744
+ |> Tuple.first
745
+
746
+ currentPage : { path : Path, route : route }
747
+ currentPage =
748
+ { path = serverRequestPayload.path, route = urlToRoute config currentUrl }
749
+
750
+ viewValue : { title : String, body : List (Html (PagesMsg userMsg)) }
751
+ viewValue =
752
+ (config.view Dict.empty Dict.empty Nothing currentPage Nothing justSharedData dataThing Nothing |> .view)
753
+ pageModel
754
+ in
755
+ { route = Path.toAbsolute currentPage.path
756
+ , contentJson = Dict.empty
757
+ , html = viewValue.body |> bodyToString
758
+ , errors = []
759
+ , head = [] -- TODO render head tags --config.view Dict.empty Dict.empty Nothing pathAndRoute Nothing justSharedData pageData Nothing |> .head
760
+ , title = viewValue.title
761
+ , staticHttpCache = Dict.empty
762
+ , is404 = False
763
+ , statusCode = statusCode
764
+ , headers = []
765
+ }
766
+ |> ToJsPayload.PageProgress
767
+ |> Effect.SendSinglePageNew byteEncodedPageData
768
+ |> BackendTask.succeed
769
+ )
770
+ )
504
771
 
505
- unprocessedPages : List ( Path, route )
506
- unprocessedPages =
507
- case renderRequest of
508
- RenderRequest.SinglePage _ serverRequestPayload _ ->
509
- case serverRequestPayload of
510
- RenderRequest.Page pageData ->
511
- [ ( pageData.path, pageData.frontmatter ) ]
772
+ Just notFoundReason ->
773
+ render404Page config
774
+ Nothing
775
+ -- TODO do I need sharedDataResult?
776
+ --(Result.toMaybe sharedDataResult)
777
+ isDevServer
778
+ serverRequestPayload.path
779
+ notFoundReason
780
+ |> BackendTask.succeed
781
+ )
512
782
 
513
- RenderRequest.Api _ ->
514
- []
783
+ RenderRequest.Api ( path, ApiRoute apiHandler ) ->
784
+ BackendTask.map2
785
+ (\response _ ->
786
+ case response of
787
+ Just okResponse ->
788
+ { body = okResponse
789
+ , staticHttpCache = Dict.empty -- TODO do I need to serialize the full cache here, or can I handle that from the JS side?
790
+ , statusCode = 200
791
+ }
792
+ |> ToJsPayload.SendApiResponse
793
+ |> Effect.SendSinglePage
515
794
 
516
- RenderRequest.NotFound _ ->
517
- []
795
+ Nothing ->
796
+ render404Page config
797
+ -- TODO do I need sharedDataResult here?
798
+ Nothing
799
+ isDevServer
800
+ (Path.fromString path)
801
+ NotFoundReason.NoMatchingRoute
802
+ --Err error ->
803
+ -- [ error ]
804
+ -- |> ToJsPayload.Errors
805
+ -- |> Effect.SendSinglePage
806
+ )
807
+ (apiHandler.matchesToResponse
808
+ (renderRequest
809
+ |> RenderRequest.maybeRequestPayload
810
+ |> Maybe.withDefault Json.Encode.null
811
+ )
812
+ path
813
+ )
814
+ globalHeadTags
815
+
816
+ RenderRequest.NotFound notFoundPath ->
817
+ (BackendTask.map2
818
+ (\_ _ ->
819
+ render404Page config
820
+ Nothing
821
+ --(Result.toMaybe sharedDataResult)
822
+ --model
823
+ isDevServer
824
+ notFoundPath
825
+ NotFoundReason.NoMatchingRoute
826
+ )
827
+ (BackendTask.succeed [])
828
+ globalHeadTags
829
+ -- TODO is there a way to resolve sharedData but get it as a Result if it fails?
830
+ --config.sharedData
831
+ )
832
+ )
518
833
 
519
834
  initialModel : Model route
520
835
  initialModel =
521
- { staticResponses = staticResponses
836
+ { staticResponses = staticResponsesNew
522
837
  , errors = []
523
- , allRawResponses = staticHttpCache
524
- , unprocessedPages = unprocessedPages
525
838
  , maybeRequestJson = renderRequest
526
839
  , isDevServer = isDevServer
527
840
  }
528
841
  in
529
- StaticResponses.nextStep initialModel Nothing
530
- |> nextStepToEffect site
531
- config
842
+ StaticResponses.nextStep (Json.Encode.object []) initialModel.staticResponses initialModel
843
+ |> nextStepToEffect
532
844
  initialModel
533
845
 
534
846
 
535
847
  updateAndSendPortIfDone :
536
- SiteConfig
537
- -> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
538
- -> Model route
848
+ Model route
539
849
  -> ( Model route, Effect )
540
- updateAndSendPortIfDone site config model =
541
- StaticResponses.nextStep
850
+ updateAndSendPortIfDone model =
851
+ StaticResponses.nextStep (Json.Encode.object [])
852
+ model.staticResponses
542
853
  model
543
- Nothing
544
- |> nextStepToEffect site config model
854
+ |> nextStepToEffect model
545
855
 
546
856
 
547
857
  {-| -}
548
858
  update :
549
- SiteConfig
550
- -> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
551
- -> Msg
859
+ Msg
552
860
  -> Model route
553
861
  -> ( Model route, Effect )
554
- update site config msg model =
862
+ update msg model =
555
863
  case msg of
556
864
  GotDataBatch batch ->
557
- let
558
- updatedModel : Model route
559
- updatedModel =
560
- model
561
- |> StaticResponses.batchUpdate batch
562
- in
563
- StaticResponses.nextStep
564
- updatedModel
565
- Nothing
566
- |> nextStepToEffect site config updatedModel
865
+ StaticResponses.nextStep batch
866
+ model.staticResponses
867
+ model
868
+ |> nextStepToEffect model
567
869
 
568
870
  GotBuildError buildError ->
569
871
  let
@@ -574,560 +876,45 @@ update site config msg model =
574
876
  buildError :: model.errors
575
877
  }
576
878
  in
577
- StaticResponses.nextStep
879
+ StaticResponses.nextStep (Json.Encode.object [])
880
+ updatedModel.staticResponses
578
881
  updatedModel
579
- Nothing
580
- |> nextStepToEffect site config updatedModel
882
+ |> nextStepToEffect updatedModel
581
883
 
582
884
 
583
885
  nextStepToEffect :
584
- SiteConfig
585
- -> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
586
- -> Model route
587
- -> ( StaticResponses, StaticResponses.NextStep route )
886
+ Model route
887
+ -> StaticResponses.NextStep route Effect
588
888
  -> ( Model route, Effect )
589
- nextStepToEffect site config model ( updatedStaticResponsesModel, nextStep ) =
889
+ nextStepToEffect model nextStep =
590
890
  case nextStep of
591
- StaticResponses.Continue updatedAllRawResponses httpRequests maybeRoutes ->
592
- let
593
- updatedUnprocessedPages : List ( Path, route )
594
- updatedUnprocessedPages =
595
- case maybeRoutes of
596
- Just newRoutes ->
597
- newRoutes
598
- |> List.map
599
- (\route ->
600
- ( Path.join (config.routeToPath route)
601
- , route
602
- )
603
- )
604
-
605
- Nothing ->
606
- model.unprocessedPages
607
-
608
- updatedModel : Model route
609
- updatedModel =
610
- { model
611
- | allRawResponses = updatedAllRawResponses
612
- , staticResponses = updatedStaticResponsesModel
613
- , unprocessedPages = updatedUnprocessedPages
614
- }
615
- in
616
- if List.isEmpty httpRequests then
617
- nextStepToEffect site
618
- config
619
- updatedModel
620
- (StaticResponses.nextStep
621
- updatedModel
622
- Nothing
623
- )
624
-
625
- else
626
- ( updatedModel
627
- , (httpRequests
628
- |> List.map Effect.FetchHttp
629
- )
630
- |> Effect.Batch
631
- )
632
-
633
- StaticResponses.Finish toJsPayload ->
634
- case toJsPayload of
635
- StaticResponses.ApiResponse ->
636
- let
637
- apiResponse : Effect
638
- apiResponse =
639
- case model.maybeRequestJson of
640
- RenderRequest.SinglePage _ requestPayload _ ->
641
- let
642
- sharedDataResult : Result BuildError sharedData
643
- sharedDataResult =
644
- StaticHttpRequest.resolve
645
- config.sharedData
646
- model.allRawResponses
647
- |> Result.mapError (StaticHttpRequest.toBuildError "")
648
- in
649
- case requestPayload of
650
- RenderRequest.Api ( path, ApiRoute apiHandler ) ->
651
- let
652
- thing : DataSource (Maybe ApiRoute.Response)
653
- thing =
654
- apiHandler.matchesToResponse path
655
- in
656
- StaticHttpRequest.resolve
657
- thing
658
- model.allRawResponses
659
- |> Result.mapError (StaticHttpRequest.toBuildError "TODO - path from request")
660
- |> (\response ->
661
- case response of
662
- Ok (Just okResponse) ->
663
- { body = okResponse
664
- , staticHttpCache = Dict.empty -- TODO do I need to serialize the full cache here, or can I handle that from the JS side?
665
-
666
- -- model.allRawResponses |> Dict.Extra.filterMap (\_ v -> v)
667
- , statusCode = 200
668
- }
669
- |> ToJsPayload.SendApiResponse
670
- |> Effect.SendSinglePage
671
-
672
- Ok Nothing ->
673
- render404Page config (Result.toMaybe sharedDataResult) model (Path.fromString path) NotFoundReason.NoMatchingRoute
674
-
675
- Err error ->
676
- [ error ]
677
- |> ToJsPayload.Errors
678
- |> Effect.SendSinglePage
679
- )
680
-
681
- RenderRequest.Page payload ->
682
- let
683
- pageFoundResult : Result BuildError (Maybe NotFoundReason)
684
- pageFoundResult =
685
- StaticHttpRequest.resolve
686
- (if model.isDevServer then
687
- -- TODO OPTIMIZATION this is redundant
688
- config.handleRoute payload.frontmatter
689
-
690
- else
691
- DataSource.succeed Nothing
692
- )
693
- model.allRawResponses
694
- |> Result.mapError (StaticHttpRequest.toBuildError (payload.path |> Path.toAbsolute))
695
- in
696
- case pageFoundResult of
697
- Ok Nothing ->
698
- sendSinglePageProgress site model.allRawResponses config model payload
699
-
700
- Ok (Just notFoundReason) ->
701
- render404Page config
702
- --Nothing
703
- (Result.toMaybe sharedDataResult)
704
- model
705
- payload.path
706
- notFoundReason
707
-
708
- Err error ->
709
- [ error ] |> ToJsPayload.Errors |> Effect.SendSinglePage
710
-
711
- RenderRequest.NotFound path ->
712
- render404Page config
713
- --Nothing
714
- (Result.toMaybe sharedDataResult)
715
- model
716
- path
717
- NotFoundReason.NoMatchingRoute
718
- in
719
- ( model
720
- , apiResponse
721
- )
722
-
723
- StaticResponses.Errors errors ->
724
- ( model
725
- , errors |> ToJsPayload.Errors |> Effect.SendSinglePage
726
- )
727
-
728
-
729
- sendSinglePageProgress :
730
- SiteConfig
731
- -> RequestsAndPending
732
- -> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
733
- -> Model route
734
- -> { path : Path, frontmatter : route }
735
- -> Effect
736
- sendSinglePageProgress site contentJson config model info =
737
- let
738
- ( page, route ) =
739
- ( info.path, info.frontmatter )
740
- in
741
- case model.maybeRequestJson of
742
- RenderRequest.SinglePage includeHtml _ _ ->
743
- let
744
- isAction : Maybe ActionRequest
745
- isAction =
746
- model.maybeRequestJson
747
- |> RenderRequest.maybeRequestPayload
748
- |> Maybe.andThen (Decode.decodeValue isActionDecoder >> Result.withDefault Nothing)
749
-
750
- pageFoundResult : Result BuildError (Maybe NotFoundReason)
751
- pageFoundResult =
752
- -- TODO OPTIMIZATION this is redundant
753
- StaticHttpRequest.resolve
754
- (if model.isDevServer then
755
- config.handleRoute route
756
-
757
- else
758
- DataSource.succeed Nothing
759
- )
760
- model.allRawResponses
761
- |> Result.mapError (StaticHttpRequest.toBuildError currentUrl.path)
762
-
763
- renderedResult : Result BuildError (PageServerResponse { head : List Head.Tag, view : String, title : String } errorPage)
764
- renderedResult =
765
- case includeHtml of
766
- RenderRequest.OnlyJson ->
767
- pageDataResult
768
- |> Result.map
769
- (\okPageData ->
770
- case okPageData of
771
- PageServerResponse.RenderPage responseInfo _ ->
772
- PageServerResponse.RenderPage
773
- { statusCode = responseInfo.statusCode
774
- , headers = responseInfo.headers
775
- }
776
- { head = []
777
- , view = "This page was not rendered because it is a JSON-only request."
778
- , title = "This page was not rendered because it is a JSON-only request."
779
- }
780
-
781
- PageServerResponse.ServerResponse serverResponse ->
782
- PageServerResponse.ServerResponse serverResponse
783
-
784
- PageServerResponse.ErrorPage error record ->
785
- PageServerResponse.ErrorPage error record
786
- )
787
-
788
- RenderRequest.HtmlAndJson ->
789
- Result.map2 Tuple.pair pageDataResult sharedDataResult
790
- |> Result.map
791
- (\( pageData_, sharedData ) ->
792
- case pageData_ of
793
- PageServerResponse.RenderPage responseInfo pageData ->
794
- let
795
- currentPage : { path : Path, route : route }
796
- currentPage =
797
- { path = page, route = urlToRoute config currentUrl }
798
-
799
- maybeActionData : Maybe actionData
800
- maybeActionData =
801
- case isAction of
802
- Just _ ->
803
- case actionDataResult of
804
- Ok (PageServerResponse.RenderPage _ actionData) ->
805
- Just actionData
806
-
807
- _ ->
808
- Nothing
809
-
810
- Nothing ->
811
- Nothing
812
-
813
- pageModel : userModel
814
- pageModel =
815
- config.init
816
- Pages.Flags.PreRenderFlags
817
- sharedData
818
- pageData
819
- maybeActionData
820
- (Just
821
- { path =
822
- { path = currentPage.path
823
- , query = Nothing
824
- , fragment = Nothing
825
- }
826
- , metadata = currentPage.route
827
- , pageUrl = Nothing
828
- }
829
- )
830
- |> Tuple.first
831
-
832
- viewValue : { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }
833
- viewValue =
834
- (config.view Dict.empty Dict.empty Nothing currentPage Nothing sharedData pageData maybeActionData |> .view) pageModel
835
- in
836
- PageServerResponse.RenderPage responseInfo
837
- { head = config.view Dict.empty Dict.empty Nothing currentPage Nothing sharedData pageData maybeActionData |> .head
838
- , view = viewValue.body |> bodyToString
839
- , title = viewValue.title
840
- }
841
-
842
- PageServerResponse.ServerResponse serverResponse ->
843
- PageServerResponse.ServerResponse serverResponse
844
-
845
- PageServerResponse.ErrorPage error record ->
846
- let
847
- currentPage : { path : Path, route : route }
848
- currentPage =
849
- { path = page, route = urlToRoute config currentUrl }
850
-
851
- pageModel : userModel
852
- pageModel =
853
- config.init
854
- Pages.Flags.PreRenderFlags
855
- sharedData
856
- pageData
857
- Nothing
858
- (Just
859
- { path =
860
- { path = currentPage.path
861
- , query = Nothing
862
- , fragment = Nothing
863
- }
864
- , metadata = currentPage.route
865
- , pageUrl = Nothing
866
- }
867
- )
868
- |> Tuple.first
869
-
870
- pageData : pageData
871
- pageData =
872
- config.errorPageToData error
873
-
874
- viewValue : { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }
875
- viewValue =
876
- (config.view Dict.empty Dict.empty Nothing currentPage Nothing sharedData pageData Nothing |> .view) pageModel
877
- in
878
- PageServerResponse.RenderPage
879
- { statusCode = config.errorStatusCode error
880
- , headers = record.headers
881
- }
882
- { head = config.view Dict.empty Dict.empty Nothing currentPage Nothing sharedData pageData Nothing |> .head
883
- , view = viewValue.body |> List.map HtmlPrinter.htmlToString |> String.join "\n"
884
- , title = viewValue.title
885
- }
886
- )
887
-
888
- currentUrl : Url
889
- currentUrl =
890
- { protocol = Url.Https
891
- , host = site.canonicalUrl
892
- , port_ = Nothing
893
- , path = page |> Path.toRelative
894
- , query = Nothing
895
- , fragment = Nothing
896
- }
897
-
898
- pageDataResult : Result BuildError (PageServerResponse pageData errorPage)
899
- pageDataResult =
900
- -- TODO OPTIMIZATION can these three be included in StaticResponses.Finish?
901
- StaticHttpRequest.resolve
902
- (case isAction of
903
- Just _ ->
904
- config.action (urlToRoute config currentUrl)
905
- |> DataSource.andThen
906
- (\something ->
907
- case something of
908
- PageServerResponse.ErrorPage a b ->
909
- PageServerResponse.ErrorPage a b
910
- |> DataSource.succeed
911
-
912
- PageServerResponse.RenderPage _ _ ->
913
- -- TODO the headers/response codes are ignored from the action here
914
- -- is that okay? Should you always do a redirect or another kind of
915
- -- server response if you want to control the headers/response code for an action (like logout & redirect, for example)?
916
- config.data (urlToRoute config currentUrl)
917
-
918
- PageServerResponse.ServerResponse a ->
919
- PageServerResponse.ServerResponse a
920
- |> DataSource.succeed
921
- )
922
-
923
- Nothing ->
924
- config.data (urlToRoute config currentUrl)
925
- )
926
- contentJson
927
- |> Result.mapError (StaticHttpRequest.toBuildError currentUrl.path)
928
-
929
- actionDataResult : Result BuildError (PageServerResponse actionData errorPage)
930
- actionDataResult =
931
- -- TODO OPTIMIZATION can these three be included in StaticResponses.Finish?
932
- StaticHttpRequest.resolve
933
- (config.action (urlToRoute config currentUrl))
934
- contentJson
935
- |> Result.mapError (StaticHttpRequest.toBuildError currentUrl.path)
936
-
937
- sharedDataResult : Result BuildError sharedData
938
- sharedDataResult =
939
- StaticHttpRequest.resolve
940
- config.sharedData
941
- contentJson
942
- |> Result.mapError (StaticHttpRequest.toBuildError currentUrl.path)
943
-
944
- globalHeadTags : DataSource (List Head.Tag)
945
- globalHeadTags =
946
- (config.globalHeadTags |> Maybe.withDefault (\_ -> DataSource.succeed [])) HtmlPrinter.htmlToString
947
-
948
- siteDataResult : Result BuildError (List Head.Tag)
949
- siteDataResult =
950
- StaticHttpRequest.resolve
951
- globalHeadTags
952
- model.allRawResponses
953
- |> Result.mapError (StaticHttpRequest.toBuildError "Site.elm")
954
- in
955
- case Result.map3 (\a b c -> ( a, b, c )) pageFoundResult renderedResult siteDataResult of
956
- Ok ( maybeNotFoundReason, renderedOrApiResponse, siteData ) ->
957
- case maybeNotFoundReason of
958
- Nothing ->
959
- let
960
- ( actionHeaders, byteEncodedPageData ) =
961
- case pageDataResult of
962
- Ok pageServerResponse ->
963
- case pageServerResponse of
964
- PageServerResponse.RenderPage ignored1 pageData ->
965
- -- TODO want to encode both shared and page data in dev server and HTML-embedded data
966
- -- but not for writing out the content.dat files - would be good to optimize this redundant data out
967
- --if model.isDevServer then
968
- case isAction of
969
- Just actionRequestKind ->
970
- case actionDataResult of
971
- Ok (PageServerResponse.RenderPage ignored2 actionData) ->
972
- case actionRequestKind of
973
- ActionResponseRequest ->
974
- ( ignored2.headers
975
- , sharedDataResult
976
- |> Result.map (\sharedData -> ResponseSketch.HotUpdate pageData sharedData (Just actionData))
977
- |> Result.withDefault (ResponseSketch.RenderPage pageData (Just actionData))
978
- |> config.encodeResponse
979
- |> Bytes.Encode.encode
980
- )
981
-
982
- ActionOnlyRequest ->
983
- ---- TODO need to encode action data when only that is requested (not ResponseSketch?)
984
- ( ignored2.headers
985
- , actionData
986
- |> config.encodeAction
987
- |> Bytes.Encode.encode
988
- )
989
-
990
- _ ->
991
- ( ignored1.headers
992
- , Bytes.Encode.encode (Bytes.Encode.unsignedInt8 0)
993
- )
994
-
995
- Nothing ->
996
- ( ignored1.headers
997
- , sharedDataResult
998
- |> Result.map (\something -> ResponseSketch.HotUpdate pageData something Nothing)
999
- |> Result.withDefault (ResponseSketch.RenderPage pageData Nothing)
1000
- |> config.encodeResponse
1001
- |> Bytes.Encode.encode
1002
- )
1003
-
1004
- --else
1005
- -- pageData
1006
- -- |> ResponseSketch.RenderPage
1007
- -- |> config.encodeResponse
1008
- -- |> Bytes.Encode.encode
1009
- PageServerResponse.ServerResponse serverResponse ->
1010
- -- TODO handle error?
1011
- ( serverResponse.headers
1012
- , PageServerResponse.toRedirect serverResponse
1013
- |> Maybe.map
1014
- (\{ location } ->
1015
- location
1016
- |> ResponseSketch.Redirect
1017
- |> config.encodeResponse
1018
- )
1019
- -- TODO handle other cases besides redirects?
1020
- |> Maybe.withDefault (Bytes.Encode.unsignedInt8 0)
1021
- |> Bytes.Encode.encode
1022
- )
1023
-
1024
- PageServerResponse.ErrorPage error { headers } ->
1025
- -- TODO this case should never happen
1026
- ( headers
1027
- , sharedDataResult
1028
- |> Result.map
1029
- (\sharedData ->
1030
- ResponseSketch.HotUpdate (config.errorPageToData error)
1031
- sharedData
1032
- Nothing
1033
- )
1034
- |> Result.map config.encodeResponse
1035
- |> Result.map Bytes.Encode.encode
1036
- |> Result.withDefault (Bytes.Encode.encode (Bytes.Encode.unsignedInt8 0))
1037
- )
891
+ StaticResponses.Continue httpRequests updatedStaticResponsesModel ->
892
+ ( { model
893
+ | staticResponses = updatedStaticResponsesModel
894
+ }
895
+ , Effect.FetchHttp httpRequests
896
+ )
1038
897
 
1039
- _ ->
1040
- -- TODO handle error?
1041
- ( []
1042
- , Bytes.Encode.encode (Bytes.Encode.unsignedInt8 0)
1043
- )
1044
- in
1045
- case renderedOrApiResponse of
1046
- PageServerResponse.RenderPage responseInfo rendered ->
1047
- { route = page |> Path.toRelative
1048
- , contentJson = Dict.empty
1049
- , html = rendered.view
1050
- , errors = []
1051
- , head = rendered.head ++ siteData
1052
- , title = rendered.title
1053
- , staticHttpCache = Dict.empty
1054
- , is404 = False
1055
- , statusCode = responseInfo.statusCode
1056
- , headers =
1057
- -- TODO should `responseInfo.headers` be used? Is there a problem in the case where there is both an action and data response in one? Do we need to make sure it is performed as two separate HTTP requests to ensure that the cookies are set correctly in that case?
1058
- actionHeaders
1059
- }
1060
- |> ToJsPayload.PageProgress
1061
- |> Effect.SendSinglePageNew byteEncodedPageData
1062
-
1063
- PageServerResponse.ServerResponse serverResponse ->
1064
- PageServerResponse.toRedirect serverResponse
1065
- |> Maybe.map
1066
- (\_ ->
1067
- { route = page |> Path.toRelative
1068
- , contentJson = Dict.empty
1069
- , html = "This is intentionally blank HTML"
1070
- , errors = []
1071
- , head = []
1072
- , title = "This is an intentionally blank title"
1073
- , staticHttpCache = Dict.empty
1074
- , is404 = False
1075
- , statusCode =
1076
- case includeHtml of
1077
- RenderRequest.OnlyJson ->
1078
- -- if this is a redirect for a `content.dat`, we don't want to send an *actual* redirect status code because the redirect needs to be handled in Elm (not by the Browser)
1079
- 200
1080
-
1081
- RenderRequest.HtmlAndJson ->
1082
- serverResponse.statusCode
1083
- , headers = serverResponse.headers
1084
- }
1085
- |> ToJsPayload.PageProgress
1086
- |> Effect.SendSinglePageNew byteEncodedPageData
1087
- )
1088
- |> Maybe.withDefault
1089
- ({ body = serverResponse |> PageServerResponse.toJson
1090
- , staticHttpCache = Dict.empty
1091
- , statusCode = serverResponse.statusCode
1092
- }
1093
- |> ToJsPayload.SendApiResponse
1094
- |> Effect.SendSinglePage
1095
- )
898
+ StaticResponses.FinishedWithErrors errors ->
899
+ ( model
900
+ , errors |> ToJsPayload.Errors |> Effect.SendSinglePage
901
+ )
1096
902
 
1097
- PageServerResponse.ErrorPage error responseInfo ->
1098
- -- TODO this case should never happen
1099
- { route = page |> Path.toRelative
1100
- , contentJson = Dict.empty
1101
- , html = "UNEXPECTED!" --HtmlPrinter.htmlToString rendered.body
1102
- , errors = []
1103
- , head = [] -- rendered.head ++ siteData -- TODO this should call ErrorPage.head maybe?
1104
- , title = "UNEXPECTED CASE" --rendered.title
1105
- , staticHttpCache = Dict.empty
1106
- , is404 = False
1107
- , statusCode = config.errorStatusCode error
1108
- , headers = responseInfo.headers
1109
- }
1110
- |> ToJsPayload.PageProgress
1111
- |> Effect.SendSinglePageNew byteEncodedPageData
1112
-
1113
- Just notFoundReason ->
1114
- render404Page config (Result.toMaybe sharedDataResult) model page notFoundReason
1115
-
1116
- Err error ->
1117
- [ error ]
1118
- |> ToJsPayload.Errors
1119
- |> Effect.SendSinglePage
903
+ StaticResponses.Finish finalValue ->
904
+ ( model
905
+ , finalValue
906
+ )
1120
907
 
1121
908
 
1122
909
  render404Page :
1123
910
  ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
1124
911
  -> Maybe sharedData
1125
- -> Model route
912
+ -> Bool
1126
913
  -> Path
1127
914
  -> NotFoundReason
1128
915
  -> Effect
1129
- render404Page config sharedData model path notFoundReason =
1130
- case ( model.isDevServer, sharedData ) of
916
+ render404Page config sharedData isDevServer path notFoundReason =
917
+ case ( isDevServer, sharedData ) of
1131
918
  ( False, Just justSharedData ) ->
1132
919
  let
1133
920
  byteEncodedPageData : Bytes
@@ -1158,7 +945,7 @@ render404Page config sharedData model path notFoundReason =
1158
945
  pathAndRoute =
1159
946
  { path = path, route = config.notFoundRoute }
1160
947
 
1161
- viewValue : { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }
948
+ viewValue : { title : String, body : List (Html (PagesMsg userMsg)) }
1162
949
  viewValue =
1163
950
  (config.view Dict.empty
1164
951
  Dict.empty
@@ -1221,7 +1008,7 @@ render404Page config sharedData model path notFoundReason =
1221
1008
 
1222
1009
  bodyToString : List (Html msg) -> String
1223
1010
  bodyToString body =
1224
- body |> List.map HtmlPrinter.htmlToString |> String.join "\n"
1011
+ body |> List.map (HtmlPrinter.htmlToString Nothing) |> String.join "\n"
1225
1012
 
1226
1013
 
1227
1014
  urlToRoute : ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage -> Url -> route
@@ -1231,3 +1018,51 @@ urlToRoute config url =
1231
1018
 
1232
1019
  else
1233
1020
  config.urlToRoute url
1021
+
1022
+
1023
+ toRedirectResponse :
1024
+ ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
1025
+ -> { b | path : Path }
1026
+ -> RenderRequest.IncludeHtml
1027
+ -> { c | headers : List ( String, String ), statusCode : Int }
1028
+ -> { response | statusCode : Int, headers : List ( String, String ) }
1029
+ -> Maybe Effect
1030
+ toRedirectResponse config serverRequestPayload includeHtml serverResponse responseMetadata =
1031
+ PageServerResponse.toRedirect responseMetadata
1032
+ |> Maybe.map
1033
+ (\_ ->
1034
+ let
1035
+ ( _, byteEncodedPageData ) =
1036
+ ( serverResponse.headers
1037
+ , PageServerResponse.toRedirect serverResponse
1038
+ |> Maybe.map
1039
+ (\{ location } ->
1040
+ location
1041
+ |> ResponseSketch.Redirect
1042
+ |> config.encodeResponse
1043
+ )
1044
+ |> Maybe.withDefault (Bytes.Encode.unsignedInt8 0)
1045
+ |> Bytes.Encode.encode
1046
+ )
1047
+ in
1048
+ { route = serverRequestPayload.path |> Path.toRelative
1049
+ , contentJson = Dict.empty
1050
+ , html = "This is intentionally blank HTML"
1051
+ , errors = []
1052
+ , head = []
1053
+ , title = "This is an intentionally blank title"
1054
+ , staticHttpCache = Dict.empty
1055
+ , is404 = False
1056
+ , statusCode =
1057
+ case includeHtml of
1058
+ RenderRequest.OnlyJson ->
1059
+ -- if this is a redirect for a `content.dat`, we don't want to send an *actual* redirect status code because the redirect needs to be handled in Elm (not by the Browser)
1060
+ 200
1061
+
1062
+ RenderRequest.HtmlAndJson ->
1063
+ responseMetadata.statusCode
1064
+ , headers = responseMetadata.headers --serverResponse.headers
1065
+ }
1066
+ |> ToJsPayload.PageProgress
1067
+ |> Effect.SendSinglePageNew byteEncodedPageData
1068
+ )