elm-pages 3.0.0-beta.4 → 3.0.0-beta.40

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 (140) hide show
  1. package/README.md +10 -1
  2. package/adapter/netlify.js +207 -0
  3. package/codegen/{elm-pages-codegen.js → elm-pages-codegen.cjs} +2678 -2725
  4. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Review-DeadCodeEliminateData.elmi +0 -0
  5. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Review-DeadCodeEliminateData.elmo +0 -0
  6. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Review-DeadCodeEliminateDataTest.elmo +0 -0
  7. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/d.dat +0 -0
  8. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/i.dat +0 -0
  9. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/o.dat +0 -0
  10. package/generator/dead-code-review/elm-stuff/tests-0.19.1/elm.json +1 -1
  11. package/generator/dead-code-review/elm-stuff/tests-0.19.1/js/Reporter.elm.js +1447 -342
  12. package/generator/dead-code-review/elm-stuff/tests-0.19.1/js/Runner.elm.js +17004 -13817
  13. package/generator/dead-code-review/elm-stuff/tests-0.19.1/js/node_runner.js +1 -1
  14. package/generator/dead-code-review/elm-stuff/tests-0.19.1/js/node_supervisor.js +4 -4
  15. package/generator/dead-code-review/elm.json +9 -7
  16. package/generator/dead-code-review/src/Pages/Review/DeadCodeEliminateData.elm +59 -10
  17. package/generator/dead-code-review/tests/Pages/Review/DeadCodeEliminateDataTest.elm +52 -36
  18. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Internal-RoutePattern.elmi +0 -0
  19. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Internal-RoutePattern.elmo +0 -0
  20. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Review-NoContractViolations.elmi +0 -0
  21. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/Pages-Review-NoContractViolations.elmo +0 -0
  22. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/d.dat +0 -0
  23. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/i.dat +0 -0
  24. package/generator/review/elm-stuff/tests-0.19.1/elm-stuff/0.19.1/o.dat +0 -0
  25. package/generator/review/elm-stuff/tests-0.19.1/elm.json +1 -1
  26. package/generator/review/elm-stuff/tests-0.19.1/js/Reporter.elm.js +1447 -342
  27. package/generator/review/elm-stuff/tests-0.19.1/js/Runner.elm.js +25025 -21739
  28. package/generator/review/elm-stuff/tests-0.19.1/js/node_runner.js +1 -1
  29. package/generator/review/elm-stuff/tests-0.19.1/js/node_supervisor.js +4 -4
  30. package/generator/review/elm.json +10 -10
  31. package/generator/src/RouteBuilder.elm +115 -109
  32. package/generator/src/SharedTemplate.elm +3 -2
  33. package/generator/src/SiteConfig.elm +3 -2
  34. package/generator/src/basepath-middleware.js +3 -3
  35. package/generator/src/build.js +209 -92
  36. package/generator/src/cli.js +292 -88
  37. package/generator/src/codegen.js +29 -27
  38. package/generator/src/compatibility-key.js +3 -0
  39. package/generator/src/compile-elm.js +43 -26
  40. package/generator/src/config.js +39 -0
  41. package/generator/src/copy-dir.js +2 -2
  42. package/generator/src/dev-server.js +176 -138
  43. package/generator/src/dir-helpers.js +9 -26
  44. package/generator/src/elm-codegen.js +5 -4
  45. package/generator/src/elm-file-constants.js +2 -3
  46. package/generator/src/error-formatter.js +12 -11
  47. package/generator/src/file-helpers.js +3 -4
  48. package/generator/src/generate-template-module-connector.js +23 -23
  49. package/generator/src/init.js +9 -8
  50. package/generator/src/pre-render-html.js +39 -28
  51. package/generator/src/render-test.js +109 -0
  52. package/generator/src/render-worker.js +25 -28
  53. package/generator/src/render.js +321 -142
  54. package/generator/src/request-cache.js +265 -162
  55. package/generator/src/resolve-elm-module.js +64 -0
  56. package/generator/src/rewrite-client-elm-json.js +6 -5
  57. package/generator/src/rewrite-elm-json-help.js +56 -0
  58. package/generator/src/rewrite-elm-json.js +17 -7
  59. package/generator/src/route-codegen-helpers.js +16 -31
  60. package/generator/src/seo-renderer.js +12 -7
  61. package/generator/src/vite-utils.js +77 -0
  62. package/generator/static-code/elm-pages.js +10 -0
  63. package/generator/static-code/hmr.js +79 -13
  64. package/generator/template/app/Api.elm +6 -5
  65. package/generator/template/app/Effect.elm +123 -0
  66. package/generator/template/app/ErrorPage.elm +37 -6
  67. package/generator/template/app/Route/Index.elm +17 -10
  68. package/generator/template/app/Shared.elm +24 -47
  69. package/generator/template/app/Site.elm +19 -6
  70. package/generator/template/app/View.elm +1 -8
  71. package/generator/template/elm-tooling.json +0 -3
  72. package/generator/template/elm.json +32 -24
  73. package/generator/template/package.json +10 -4
  74. package/package.json +30 -27
  75. package/src/ApiRoute.elm +199 -61
  76. package/src/BackendTask/Custom.elm +325 -0
  77. package/src/BackendTask/Env.elm +90 -0
  78. package/src/{DataSource → BackendTask}/File.elm +171 -56
  79. package/src/{DataSource → BackendTask}/Glob.elm +136 -125
  80. package/src/BackendTask/Http.elm +679 -0
  81. package/src/{DataSource → BackendTask}/Internal/Glob.elm +1 -1
  82. package/src/BackendTask/Internal/Request.elm +69 -0
  83. package/src/BackendTask/Random.elm +79 -0
  84. package/src/BackendTask/Time.elm +47 -0
  85. package/src/BackendTask.elm +537 -0
  86. package/src/FatalError.elm +90 -0
  87. package/src/Head.elm +237 -7
  88. package/src/HtmlPrinter.elm +7 -3
  89. package/src/Internal/ApiRoute.elm +7 -5
  90. package/src/PageServerResponse.elm +6 -1
  91. package/src/Pages/Form.elm +229 -0
  92. package/src/Pages/GeneratorProgramConfig.elm +15 -0
  93. package/src/Pages/Internal/FatalError.elm +5 -0
  94. package/src/Pages/Internal/Msg.elm +93 -0
  95. package/src/Pages/Internal/Platform/Cli.elm +612 -763
  96. package/src/Pages/Internal/Platform/CompatibilityKey.elm +6 -0
  97. package/src/Pages/Internal/Platform/Effect.elm +1 -2
  98. package/src/Pages/Internal/Platform/GeneratorApplication.elm +379 -0
  99. package/src/Pages/Internal/Platform/StaticResponses.elm +65 -276
  100. package/src/Pages/Internal/Platform/ToJsPayload.elm +6 -9
  101. package/src/Pages/Internal/Platform.elm +327 -194
  102. package/src/Pages/Internal/Script.elm +17 -0
  103. package/src/Pages/Internal/StaticHttpBody.elm +35 -1
  104. package/src/Pages/Manifest.elm +29 -4
  105. package/src/Pages/PageUrl.elm +23 -9
  106. package/src/Pages/ProgramConfig.elm +26 -15
  107. package/src/Pages/Script.elm +109 -0
  108. package/src/Pages/SiteConfig.elm +3 -2
  109. package/src/Pages/StaticHttp/Request.elm +2 -2
  110. package/src/Pages/StaticHttpRequest.elm +23 -99
  111. package/src/Pages/Transition.elm +12 -3
  112. package/src/PagesMsg.elm +82 -0
  113. package/src/Path.elm +16 -19
  114. package/src/QueryParams.elm +21 -172
  115. package/src/RequestsAndPending.elm +37 -20
  116. package/src/Result/Extra.elm +26 -0
  117. package/src/Scaffold/Form.elm +546 -0
  118. package/src/Scaffold/Route.elm +1402 -0
  119. package/src/Server/Request.elm +73 -72
  120. package/src/Server/Session.elm +62 -42
  121. package/src/Server/SetCookie.elm +12 -4
  122. package/src/Stub.elm +53 -0
  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/Form/Field.elm +0 -717
  130. package/src/Form/FieldStatus.elm +0 -36
  131. package/src/Form/FieldView.elm +0 -417
  132. package/src/Form/FormData.elm +0 -22
  133. package/src/Form/Validation.elm +0 -391
  134. package/src/Form/Value.elm +0 -118
  135. package/src/Form.elm +0 -1683
  136. package/src/FormDecoder.elm +0 -102
  137. package/src/Pages/FormState.elm +0 -256
  138. package/src/Pages/Generate.elm +0 -800
  139. package/src/Pages/Internal/Form.elm +0 -17
  140. package/src/Pages/Msg.elm +0 -79
@@ -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
- import Dict
16
- import Head
14
+ import Dict exposing (Dict)
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,494 @@ 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 _ ->
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
+ case singleRequest of
392
+ RenderRequest.Page serverRequestPayload ->
442
393
  let
443
- globalHeadTags : DataSource (List Head.Tag)
444
- globalHeadTags =
445
- (config.globalHeadTags |> Maybe.withDefault (\_ -> DataSource.succeed [])) HtmlPrinter.htmlToString
394
+ isAction : Maybe ActionRequest
395
+ isAction =
396
+ renderRequest
397
+ |> RenderRequest.maybeRequestPayload
398
+ |> Maybe.andThen (Decode.decodeValue isActionDecoder >> Result.withDefault Nothing)
399
+
400
+ currentUrl : Url
401
+ currentUrl =
402
+ { protocol = Url.Https
403
+ , host = site.canonicalUrl
404
+ , port_ = Nothing
405
+ , path = serverRequestPayload.path |> Path.toRelative
406
+ , query = Nothing
407
+ , fragment = Nothing
408
+ }
446
409
  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
- )
410
+ --case isAction of
411
+ -- Just actionRequest ->
412
+ (if isDevServer then
413
+ config.handleRoute serverRequestPayload.frontmatter
477
414
 
415
+ else
416
+ BackendTask.succeed Nothing
417
+ )
418
+ |> BackendTask.andThen
419
+ (\pageFound ->
420
+ case pageFound of
478
421
  Nothing ->
479
- DataSource.map3 (\_ _ _ -> ())
480
- (config.data serverRequestPayload.frontmatter)
481
- config.sharedData
482
- globalHeadTags
483
- )
484
- (if isDevServer then
485
- config.handleRoute serverRequestPayload.frontmatter
422
+ --sendSinglePageProgress site model.allRawResponses config model payload
423
+ (case isAction of
424
+ Just _ ->
425
+ config.action (RenderRequest.maybeRequestPayload renderRequest |> Maybe.withDefault Json.Encode.null) serverRequestPayload.frontmatter |> BackendTask.map Just
486
426
 
487
- else
488
- DataSource.succeed Nothing
489
- )
427
+ Nothing ->
428
+ BackendTask.succeed Nothing
429
+ )
430
+ |> BackendTask.andThen
431
+ (\something ->
432
+ let
433
+ actionHeaders2 : Maybe { statusCode : Int, headers : List ( String, String ) }
434
+ actionHeaders2 =
435
+ case something of
436
+ Just (PageServerResponse.RenderPage responseThing _) ->
437
+ Just responseThing
438
+
439
+ Just (PageServerResponse.ServerResponse responseThing) ->
440
+ Just
441
+ { headers = responseThing.headers
442
+ , statusCode = responseThing.statusCode
443
+ }
490
444
 
491
- RenderRequest.Api ( path, ApiRoute apiRequest ) ->
492
- StaticResponses.renderApiRequest
493
- (DataSource.map2 (\_ _ -> ())
494
- (apiRequest.matchesToResponse path)
495
- globalHeadTags
496
- )
445
+ _ ->
446
+ Nothing
497
447
 
498
- RenderRequest.NotFound _ ->
499
- StaticResponses.renderApiRequest
500
- (DataSource.map2 (\_ _ -> ())
501
- (DataSource.succeed [])
502
- globalHeadTags
503
- )
448
+ maybeRedirectResponse : Maybe Effect
449
+ maybeRedirectResponse =
450
+ actionHeaders2
451
+ |> Maybe.andThen
452
+ (\responseMetadata ->
453
+ toRedirectResponse config
454
+ serverRequestPayload
455
+ includeHtml
456
+ responseMetadata
457
+ responseMetadata
458
+ )
459
+ in
460
+ case maybeRedirectResponse of
461
+ Just redirectResponse ->
462
+ redirectResponse
463
+ |> BackendTask.succeed
504
464
 
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 ) ]
465
+ Nothing ->
466
+ BackendTask.map3
467
+ (\pageData sharedData tags ->
468
+ let
469
+ renderedResult : Effect
470
+ renderedResult =
471
+ case pageData of
472
+ PageServerResponse.RenderPage responseInfo pageData_ ->
473
+ let
474
+ currentPage : { path : Path, route : route }
475
+ currentPage =
476
+ { path = serverRequestPayload.path, route = urlToRoute config currentUrl }
477
+
478
+ maybeActionData : Maybe actionData
479
+ maybeActionData =
480
+ case something of
481
+ Just (PageServerResponse.RenderPage _ actionThing) ->
482
+ Just actionThing
483
+
484
+ _ ->
485
+ Nothing
486
+
487
+ pageModel : userModel
488
+ pageModel =
489
+ config.init
490
+ Pages.Flags.PreRenderFlags
491
+ sharedData
492
+ pageData_
493
+ maybeActionData
494
+ (Just
495
+ { path =
496
+ { path = currentPage.path
497
+ , query = Nothing
498
+ , fragment = Nothing
499
+ }
500
+ , metadata = currentPage.route
501
+ , pageUrl = Nothing
502
+ }
503
+ )
504
+ |> Tuple.first
505
+
506
+ viewValue : { title : String, body : List (Html (PagesMsg userMsg)) }
507
+ viewValue =
508
+ (config.view Dict.empty Dict.empty Nothing currentPage Nothing sharedData pageData_ maybeActionData |> .view) pageModel
509
+
510
+ responseMetadata : { statusCode : Int, headers : List ( String, String ) }
511
+ responseMetadata =
512
+ actionHeaders2 |> Maybe.withDefault responseInfo
513
+ in
514
+ (case isAction of
515
+ Just actionRequestKind ->
516
+ let
517
+ actionDataResult : Maybe (PageServerResponse actionData errorPage)
518
+ actionDataResult =
519
+ something
520
+ in
521
+ case actionDataResult of
522
+ Just (PageServerResponse.RenderPage ignored2 actionData_) ->
523
+ case actionRequestKind of
524
+ ActionResponseRequest ->
525
+ ( ignored2.headers
526
+ , ResponseSketch.HotUpdate pageData_ sharedData (Just actionData_)
527
+ |> config.encodeResponse
528
+ |> Bytes.Encode.encode
529
+ )
530
+
531
+ ActionOnlyRequest ->
532
+ ---- TODO need to encode action data when only that is requested (not ResponseSketch?)
533
+ ( ignored2.headers
534
+ , actionData_
535
+ |> config.encodeAction
536
+ |> Bytes.Encode.encode
537
+ )
538
+
539
+ _ ->
540
+ ( responseMetadata.headers
541
+ , Bytes.Encode.encode (Bytes.Encode.unsignedInt8 0)
542
+ )
543
+
544
+ Nothing ->
545
+ ( responseMetadata.headers
546
+ , ResponseSketch.HotUpdate pageData_ sharedData Nothing
547
+ |> config.encodeResponse
548
+ |> Bytes.Encode.encode
549
+ )
550
+ )
551
+ |> (\( actionHeaders, byteEncodedPageData ) ->
552
+ let
553
+ rendered : { view : userModel -> { title : String, body : List (Html (PagesMsg userMsg)) }, head : List Tag }
554
+ rendered =
555
+ config.view Dict.empty Dict.empty Nothing currentPage Nothing sharedData pageData_ maybeActionData
556
+ in
557
+ PageServerResponse.toRedirect responseMetadata
558
+ |> Maybe.map
559
+ (\{ location } ->
560
+ location
561
+ |> ResponseSketch.Redirect
562
+ |> config.encodeResponse
563
+ |> Bytes.Encode.encode
564
+ )
565
+ -- TODO handle other cases besides redirects?
566
+ |> Maybe.withDefault byteEncodedPageData
567
+ |> (\encodedData ->
568
+ { route = currentPage.path |> Path.toRelative
569
+ , contentJson = Dict.empty
570
+ , html = viewValue.body |> bodyToString
571
+ , errors = []
572
+ , head = rendered.head ++ tags
573
+ , title = viewValue.title
574
+ , staticHttpCache = Dict.empty
575
+ , is404 = False
576
+ , statusCode =
577
+ case includeHtml of
578
+ RenderRequest.OnlyJson ->
579
+ 200
580
+
581
+ RenderRequest.HtmlAndJson ->
582
+ responseMetadata.statusCode
583
+ , headers =
584
+ -- 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?
585
+ actionHeaders
586
+ |> combineHeaders
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 |> combineHeaders
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
512
726
 
513
- RenderRequest.Api _ ->
514
- []
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 = Dict.empty
765
+ }
766
+ |> ToJsPayload.PageProgress
767
+ |> Effect.SendSinglePageNew byteEncodedPageData
768
+ |> BackendTask.succeed
769
+ )
770
+ )
515
771
 
516
- RenderRequest.NotFound _ ->
517
- []
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
+ )
782
+
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
794
+
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
+ )
518
832
 
519
833
  initialModel : Model route
520
834
  initialModel =
521
- { staticResponses = staticResponses
835
+ { staticResponses = staticResponsesNew
522
836
  , errors = []
523
- , allRawResponses = staticHttpCache
524
- , unprocessedPages = unprocessedPages
525
837
  , maybeRequestJson = renderRequest
526
838
  , isDevServer = isDevServer
527
839
  }
528
840
  in
529
- StaticResponses.nextStep initialModel Nothing
530
- |> nextStepToEffect site
531
- config
841
+ StaticResponses.nextStep (Json.Encode.object []) initialModel.staticResponses initialModel
842
+ |> nextStepToEffect
532
843
  initialModel
533
844
 
534
845
 
535
846
  updateAndSendPortIfDone :
536
- SiteConfig
537
- -> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
538
- -> Model route
847
+ Model route
539
848
  -> ( Model route, Effect )
540
- updateAndSendPortIfDone site config model =
541
- StaticResponses.nextStep
849
+ updateAndSendPortIfDone model =
850
+ StaticResponses.nextStep (Json.Encode.object [])
851
+ model.staticResponses
542
852
  model
543
- Nothing
544
- |> nextStepToEffect site config model
853
+ |> nextStepToEffect model
545
854
 
546
855
 
547
856
  {-| -}
548
857
  update :
549
- SiteConfig
550
- -> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
551
- -> Msg
858
+ Msg
552
859
  -> Model route
553
860
  -> ( Model route, Effect )
554
- update site config msg model =
861
+ update msg model =
555
862
  case msg of
556
863
  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
864
+ StaticResponses.nextStep batch
865
+ model.staticResponses
866
+ model
867
+ |> nextStepToEffect model
567
868
 
568
869
  GotBuildError buildError ->
569
870
  let
@@ -574,560 +875,45 @@ update site config msg model =
574
875
  buildError :: model.errors
575
876
  }
576
877
  in
577
- StaticResponses.nextStep
878
+ StaticResponses.nextStep (Json.Encode.object [])
879
+ updatedModel.staticResponses
578
880
  updatedModel
579
- Nothing
580
- |> nextStepToEffect site config updatedModel
881
+ |> nextStepToEffect updatedModel
581
882
 
582
883
 
583
884
  nextStepToEffect :
584
- SiteConfig
585
- -> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
586
- -> Model route
587
- -> ( StaticResponses, StaticResponses.NextStep route )
885
+ Model route
886
+ -> StaticResponses.NextStep route Effect
588
887
  -> ( Model route, Effect )
589
- nextStepToEffect site config model ( updatedStaticResponsesModel, nextStep ) =
888
+ nextStepToEffect model nextStep =
590
889
  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
- )
1038
-
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
- )
1096
-
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
890
+ StaticResponses.Continue httpRequests updatedStaticResponsesModel ->
891
+ ( { model
892
+ | staticResponses = updatedStaticResponsesModel
893
+ }
894
+ , Effect.FetchHttp httpRequests
895
+ )
1112
896
 
1113
- Just notFoundReason ->
1114
- render404Page config (Result.toMaybe sharedDataResult) model page notFoundReason
897
+ StaticResponses.FinishedWithErrors errors ->
898
+ ( model
899
+ , errors |> ToJsPayload.Errors |> Effect.SendSinglePage
900
+ )
1115
901
 
1116
- Err error ->
1117
- [ error ]
1118
- |> ToJsPayload.Errors
1119
- |> Effect.SendSinglePage
902
+ StaticResponses.Finish finalValue ->
903
+ ( model
904
+ , finalValue
905
+ )
1120
906
 
1121
907
 
1122
908
  render404Page :
1123
909
  ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
1124
910
  -> Maybe sharedData
1125
- -> Model route
911
+ -> Bool
1126
912
  -> Path
1127
913
  -> NotFoundReason
1128
914
  -> Effect
1129
- render404Page config sharedData model path notFoundReason =
1130
- case ( model.isDevServer, sharedData ) of
915
+ render404Page config sharedData isDevServer path notFoundReason =
916
+ case ( isDevServer, sharedData ) of
1131
917
  ( False, Just justSharedData ) ->
1132
918
  let
1133
919
  byteEncodedPageData : Bytes
@@ -1158,7 +944,7 @@ render404Page config sharedData model path notFoundReason =
1158
944
  pathAndRoute =
1159
945
  { path = path, route = config.notFoundRoute }
1160
946
 
1161
- viewValue : { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }
947
+ viewValue : { title : String, body : List (Html (PagesMsg userMsg)) }
1162
948
  viewValue =
1163
949
  (config.view Dict.empty
1164
950
  Dict.empty
@@ -1181,7 +967,7 @@ render404Page config sharedData model path notFoundReason =
1181
967
  , staticHttpCache = Dict.empty
1182
968
  , is404 = True
1183
969
  , statusCode = 404
1184
- , headers = []
970
+ , headers = Dict.empty
1185
971
  }
1186
972
  |> ToJsPayload.PageProgress
1187
973
  |> Effect.SendSinglePageNew byteEncodedPageData
@@ -1213,7 +999,7 @@ render404Page config sharedData model path notFoundReason =
1213
999
  --model.allRawResponses |> Dict.Extra.filterMap (\_ v -> v)
1214
1000
  , is404 = True
1215
1001
  , statusCode = 404
1216
- , headers = []
1002
+ , headers = Dict.empty
1217
1003
  }
1218
1004
  |> ToJsPayload.PageProgress
1219
1005
  |> Effect.SendSinglePageNew byteEncodedPageData
@@ -1221,7 +1007,7 @@ render404Page config sharedData model path notFoundReason =
1221
1007
 
1222
1008
  bodyToString : List (Html msg) -> String
1223
1009
  bodyToString body =
1224
- body |> List.map HtmlPrinter.htmlToString |> String.join "\n"
1010
+ body |> List.map (HtmlPrinter.htmlToString Nothing) |> String.join "\n"
1225
1011
 
1226
1012
 
1227
1013
  urlToRoute : ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage -> Url -> route
@@ -1231,3 +1017,66 @@ urlToRoute config url =
1231
1017
 
1232
1018
  else
1233
1019
  config.urlToRoute url
1020
+
1021
+
1022
+ toRedirectResponse :
1023
+ ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
1024
+ -> { b | path : Path }
1025
+ -> RenderRequest.IncludeHtml
1026
+ -> { c | headers : List ( String, String ), statusCode : Int }
1027
+ -> { response | statusCode : Int, headers : List ( String, String ) }
1028
+ -> Maybe Effect
1029
+ toRedirectResponse config serverRequestPayload includeHtml serverResponse responseMetadata =
1030
+ PageServerResponse.toRedirect responseMetadata
1031
+ |> Maybe.map
1032
+ (\_ ->
1033
+ let
1034
+ ( _, byteEncodedPageData ) =
1035
+ ( serverResponse.headers
1036
+ , PageServerResponse.toRedirect serverResponse
1037
+ |> Maybe.map
1038
+ (\{ location } ->
1039
+ location
1040
+ |> ResponseSketch.Redirect
1041
+ |> config.encodeResponse
1042
+ )
1043
+ |> Maybe.withDefault (Bytes.Encode.unsignedInt8 0)
1044
+ |> Bytes.Encode.encode
1045
+ )
1046
+ in
1047
+ { route = serverRequestPayload.path |> Path.toRelative
1048
+ , contentJson = Dict.empty
1049
+ , html = "This is intentionally blank HTML"
1050
+ , errors = []
1051
+ , head = []
1052
+ , title = "This is an intentionally blank title"
1053
+ , staticHttpCache = Dict.empty
1054
+ , is404 = False
1055
+ , statusCode =
1056
+ case includeHtml of
1057
+ RenderRequest.OnlyJson ->
1058
+ -- 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)
1059
+ 200
1060
+
1061
+ RenderRequest.HtmlAndJson ->
1062
+ responseMetadata.statusCode
1063
+ , headers = responseMetadata.headers |> combineHeaders
1064
+ }
1065
+ |> ToJsPayload.PageProgress
1066
+ |> Effect.SendSinglePageNew byteEncodedPageData
1067
+ )
1068
+
1069
+
1070
+ combineHeaders : List ( String, String ) -> Dict String (List String)
1071
+ combineHeaders headers =
1072
+ headers
1073
+ |> List.foldl
1074
+ (\( key, value ) dict ->
1075
+ Dict.update key
1076
+ (Maybe.map ((::) value)
1077
+ >> Maybe.withDefault [ value ]
1078
+ >> Just
1079
+ )
1080
+ dict
1081
+ )
1082
+ Dict.empty