elm-pages 3.0.0-beta.13 → 3.0.0-beta.14

package/src/Pages/Internal/Platform/Cli.elm.bak

@@ -11,7 +11,7 @@ import BuildError exposing (BuildError)
 import Bytes exposing (Bytes)
 import Bytes.Encode
 import Codec
-import DataSource exposing (DataSource)
+import BackendTask exposing (BackendTask)
 import Dict
 import Head
 import Html exposing (Html)
@@ -483,9 +483,9 @@ initLegacy site renderRequest { staticHttpCache, isDevServer } config =
             case renderRequest of
                 RenderRequest.SinglePage _ singleRequest _ ->
                     let
-                        globalHeadTags : DataSource (List Head.Tag)
+                        globalHeadTags : BackendTask (List Head.Tag)
                         globalHeadTags =
-                            (config.globalHeadTags |> Maybe.withDefault (\_ -> DataSource.succeed [])) HtmlPrinter.htmlToString
+                            (config.globalHeadTags |> Maybe.withDefault (\_ -> BackendTask.succeed [])) HtmlPrinter.htmlToString
                     in
                     case singleRequest of
                         RenderRequest.Page serverRequestPayload ->
@@ -500,26 +500,26 @@ initLegacy site renderRequest { staticHttpCache, isDevServer } config =
                                 (case isAction of
                                     Just _ ->
                                         config.action serverRequestPayload.frontmatter
-                                            |> DataSource.andThen
+                                            |> BackendTask.andThen
                                                 (\something ->
                                                     case something of
                                                         PageServerResponse.ErrorPage _ _ ->
-                                                            DataSource.succeed something
-                                                                |> DataSource.map (\_ -> ())
+                                                            BackendTask.succeed something
+                                                                |> BackendTask.map (\_ -> ())
 
                                                         PageServerResponse.RenderPage _ _ ->
-                                                            DataSource.map3 (\_ _ _ -> ())
+                                                            BackendTask.map3 (\_ _ _ -> ())
                                                                 (config.data serverRequestPayload.frontmatter)
                                                                 config.sharedData
                                                                 globalHeadTags
 
                                                         PageServerResponse.ServerResponse _ ->
-                                                            DataSource.succeed something
-                                                                |> DataSource.map (\_ -> ())
+                                                            BackendTask.succeed something
+                                                                |> BackendTask.map (\_ -> ())
                                                 )
 
                                     Nothing ->
-                                        DataSource.map3 (\_ _ _ -> ())
+                                        BackendTask.map3 (\_ _ _ -> ())
                                             (config.data serverRequestPayload.frontmatter)
                                             config.sharedData
                                             globalHeadTags
@@ -528,20 +528,20 @@ initLegacy site renderRequest { staticHttpCache, isDevServer } config =
                                     config.handleRoute serverRequestPayload.frontmatter
 
                                  else
-                                    DataSource.succeed Nothing
+                                    BackendTask.succeed Nothing
                                 )
 
                         RenderRequest.Api ( path, ApiRoute apiRequest ) ->
                             StaticResponses.renderApiRequest
-                                (DataSource.map2 (\_ _ -> ())
+                                (BackendTask.map2 (\_ _ -> ())
                                     (apiRequest.matchesToResponse path)
                                     globalHeadTags
                                 )
 
                         RenderRequest.NotFound _ ->
                             StaticResponses.renderApiRequest
-                                (DataSource.map2 (\_ _ -> ())
-                                    (DataSource.succeed [])
+                                (BackendTask.map2 (\_ _ -> ())
+                                    (BackendTask.succeed [])
                                     globalHeadTags
                                 )
 
@@ -692,7 +692,7 @@ nextStepToEffect site config model ( updatedStaticResponsesModel, nextStep ) =
                                     case requestPayload of
                                         RenderRequest.Api ( path, ApiRoute apiHandler ) ->
                                             let
-                                                thing : DataSource (Maybe ApiRoute.Response)
+                                                thing : BackendTask (Maybe ApiRoute.Response)
                                                 thing =
                                                     apiHandler.matchesToResponse path
                                             in
@@ -731,7 +731,7 @@ nextStepToEffect site config model ( updatedStaticResponsesModel, nextStep ) =
                                                             config.handleRoute payload.frontmatter
 
                                                          else
-                                                            DataSource.succeed Nothing
+                                                            BackendTask.succeed Nothing
                                                         )
                                                         model.allRawResponses
                                                         |> Result.mapError (StaticHttpRequest.toBuildError (payload.path |> Path.toAbsolute))
@@ -798,7 +798,7 @@ sendSinglePageProgress site contentJson config model info =
                             config.handleRoute route
 
                          else
-                            DataSource.succeed Nothing
+                            BackendTask.succeed Nothing
                         )
                         model.allRawResponses
                         |> Result.mapError (StaticHttpRequest.toBuildError currentUrl.path)
@@ -945,12 +945,12 @@ sendSinglePageProgress site contentJson config model info =
                         (case isAction of
                             Just _ ->
                                 config.action (urlToRoute config currentUrl)
-                                    |> DataSource.andThen
+                                    |> BackendTask.andThen
                                         (\something ->
                                             case something of
                                                 PageServerResponse.ErrorPage a b ->
                                                     PageServerResponse.ErrorPage a b
-                                                        |> DataSource.succeed
+                                                        |> BackendTask.succeed
 
                                                 PageServerResponse.RenderPage _ _ ->
                                                     -- TODO the headers/response codes are ignored from the action here
@@ -960,7 +960,7 @@ sendSinglePageProgress site contentJson config model info =
 
                                                 PageServerResponse.ServerResponse a ->
                                                     PageServerResponse.ServerResponse a
-                                                        |> DataSource.succeed
+                                                        |> BackendTask.succeed
                                         )
 
                             Nothing ->
@@ -984,9 +984,9 @@ sendSinglePageProgress site contentJson config model info =
                         contentJson
                         |> Result.mapError (StaticHttpRequest.toBuildError currentUrl.path)
 
-                globalHeadTags : DataSource (List Head.Tag)
+                globalHeadTags : BackendTask (List Head.Tag)
                 globalHeadTags =
-                    (config.globalHeadTags |> Maybe.withDefault (\_ -> DataSource.succeed [])) HtmlPrinter.htmlToString
+                    (config.globalHeadTags |> Maybe.withDefault (\_ -> BackendTask.succeed [])) HtmlPrinter.htmlToString
 
                 siteDataResult : Result BuildError (List Head.Tag)
                 siteDataResult =

package/src/Pages/Internal/Platform/CompatibilityKey.elm

@@ -3,4 +3,4 @@ module Pages.Internal.Platform.CompatibilityKey exposing (currentCompatibilityKe
 
 currentCompatibilityKey : Int
 currentCompatibilityKey =
-    3
+    4

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

@@ -11,4 +11,3 @@ type Effect
     | Batch (List Effect)
     | SendSinglePage ToJsSuccessPayloadNewCombined
     | SendSinglePageNew Bytes ToJsSuccessPayloadNewCombined
-    | Continue

package/src/Pages/Internal/Platform/GeneratorApplication.elm

@@ -6,22 +6,22 @@ module Pages.Internal.Platform.GeneratorApplication exposing (Flags, Model, Msg(
 
 -}
 
+import BackendTask exposing (BackendTask)
 import BuildError exposing (BuildError)
 import Cli.Program as Program exposing (FlagsIncludingArgv)
 import Codec
-import DataSource exposing (DataSource)
 import Dict
+import Exception exposing (Throwable)
 import HtmlPrinter
 import Json.Decode as Decode
-import Json.Encode
+import Json.Encode as Encode
 import Pages.GeneratorProgramConfig exposing (GeneratorProgramConfig)
 import Pages.Internal.Platform.CompatibilityKey
 import Pages.Internal.Platform.Effect as Effect exposing (Effect)
-import Pages.Internal.Platform.StaticResponses as StaticResponses exposing (StaticResponses)
+import Pages.Internal.Platform.StaticResponses as StaticResponses
 import Pages.Internal.Platform.ToJsPayload as ToJsPayload
 import Pages.Internal.Script
 import Pages.StaticHttp.Request
-import Pages.StaticHttpRequest as StaticHttpRequest
 import RequestsAndPending exposing (RequestsAndPending)
 import TerminalText as Terminal
 
@@ -34,7 +34,7 @@ type alias Flags =
 
 {-| -}
 type alias Model =
-    { staticResponses : StaticResponses
+    { staticResponses : BackendTask Throwable ()
     , errors : List BuildError
     , allRawResponses : RequestsAndPending
     , done : Bool
@@ -43,22 +43,17 @@ type alias Model =
 
 {-| -}
 type Msg
-    = GotDataBatch
-        (List
-            { request : Pages.StaticHttp.Request.Request
-            , response : RequestsAndPending.Response
-            }
-        )
+    = GotDataBatch Decode.Value
     | GotBuildError BuildError
 
 
 {-| -}
 app :
     GeneratorProgramConfig
-    -> Program.StatefulProgram Model Msg (DataSource ()) Flags
+    -> Program.StatefulProgram Model Msg (BackendTask Throwable ()) Flags
 app config =
     let
-        cliConfig : Program.Config (DataSource ())
+        cliConfig : Program.Config (BackendTask Throwable ())
         cliConfig =
             case config.data of
                 Pages.Internal.Script.Script theCliConfig ->
@@ -70,8 +65,8 @@ app config =
                 init cliOptions flags
                     |> Tuple.mapSecond (perform config)
         , update =
-            \cliOptions msg model ->
-                update cliOptions msg model
+            \_ msg model ->
+                update msg model
                     |> Tuple.mapSecond (perform config)
         , subscriptions =
             \_ ->
@@ -118,23 +113,7 @@ app config =
                                         )
                                     |> mergeResult
                             )
-                    , config.gotBatchSub
-                        |> Sub.map
-                            (\newBatch ->
-                                Decode.decodeValue batchDecoder newBatch
-                                    |> Result.map GotDataBatch
-                                    |> Result.mapError
-                                        (\error ->
-                                            ("From location 2: "
-                                                ++ (error
-                                                        |> Decode.errorToString
-                                                   )
-                                            )
-                                                |> BuildError.internal
-                                                |> GotBuildError
-                                        )
-                                    |> mergeResult
-                            )
+                    , config.gotBatchSub |> Sub.map GotDataBatch
                     ]
         , config = cliConfig
         , printAndExitFailure =
@@ -151,18 +130,10 @@ app config =
                     |> Codec.encodeToValue (ToJsPayload.successCodecNew2 "" "")
                     |> config.toJsPort
                     |> Cmd.map never
-        , printAndExitSuccess = \string -> config.toJsPort (Json.Encode.string string) |> Cmd.map never
+        , printAndExitSuccess = \string -> config.toJsPort (Encode.string string) |> Cmd.map never
         }
 
 
-batchDecoder : Decode.Decoder (List { request : Pages.StaticHttp.Request.Request, response : RequestsAndPending.Response })
-batchDecoder =
-    Decode.map2 (\request response -> { request = request, response = response })
-        (Decode.field "request" requestDecoder)
-        (Decode.field "response" RequestsAndPending.decoder)
-        |> Decode.list
-
-
 mergeResult : Result a a -> a
 mergeResult r =
     case r of
@@ -216,7 +187,7 @@ perform config effect =
             flatten config list
 
         Effect.FetchHttp unmasked ->
-            ToJsPayload.DoHttp unmasked unmasked.useCache
+            ToJsPayload.DoHttp (Pages.StaticHttp.Request.hash unmasked) unmasked
                 |> Codec.encoder (ToJsPayload.successCodecNew2 canonicalSiteUrl "")
                 |> config.toJsPort
                 |> Cmd.map never
@@ -256,9 +227,6 @@ perform config effect =
                 |> config.sendPageData
                 |> Cmd.map never
 
-        Effect.Continue ->
-            Cmd.none
-
 
 
 -- TODO use Json.Decode.Value for flagsDecoder instead of hardcoded record flags
@@ -281,12 +249,12 @@ perform config effect =
 
 {-| -}
 init :
-    DataSource ()
+    BackendTask Throwable ()
     -> FlagsIncludingArgv Flags
     -> ( Model, Effect )
 init execute flags =
     if flags.compatibilityKey == Pages.Internal.Platform.CompatibilityKey.currentCompatibilityKey then
-        initLegacy execute { staticHttpCache = Dict.empty }
+        initLegacy execute
 
     else
         let
@@ -304,8 +272,8 @@ init execute flags =
                             "The elm-pages NPM package is ahead of the elm-pages Elm package. Try updating the elm-pages Elm package?"
                        )
         in
-        updateAndSendPortIfDone execute
-            { staticResponses = StaticResponses.empty
+        updateAndSendPortIfDone
+            { staticResponses = StaticResponses.empty ()
             , errors =
                 [ { title = "Incompatible NPM and Elm package versions"
                   , message = [ Terminal.text <| message ]
@@ -313,18 +281,17 @@ init execute flags =
                   , path = ""
                   }
                 ]
-            , allRawResponses = Dict.empty
+            , allRawResponses = Encode.object []
             , done = False
             }
 
 
 initLegacy :
-    DataSource ()
-    -> { staticHttpCache : RequestsAndPending }
+    BackendTask Throwable ()
     -> ( Model, Effect )
-initLegacy execute { staticHttpCache } =
+initLegacy execute =
     let
-        staticResponses : StaticResponses
+        staticResponses : BackendTask Throwable ()
         staticResponses =
             StaticResponses.renderApiRequest execute
 
@@ -332,33 +299,30 @@ initLegacy execute { staticHttpCache } =
         initialModel =
             { staticResponses = staticResponses
             , errors = []
-            , allRawResponses = staticHttpCache
+            , allRawResponses = Encode.object []
             , done = False
             }
     in
-    StaticResponses.nextStep initialModel Nothing
-        |> nextStepToEffect execute
+    StaticResponses.nextStep initialModel
+        |> nextStepToEffect
             initialModel
 
 
 updateAndSendPortIfDone :
-    DataSource ()
-    -> Model
+    Model
     -> ( Model, Effect )
-updateAndSendPortIfDone execute model =
+updateAndSendPortIfDone model =
     StaticResponses.nextStep
         model
-        Nothing
-        |> nextStepToEffect execute model
+        |> nextStepToEffect model
 
 
 {-| -}
 update :
-    DataSource ()
-    -> Msg
+    Msg
     -> Model
     -> ( Model, Effect )
-update execute msg model =
+update msg model =
     case msg of
         GotDataBatch batch ->
             let
@@ -369,8 +333,7 @@ update execute msg model =
             in
             StaticResponses.nextStep
                 updatedModel
-                Nothing
-                |> nextStepToEffect execute updatedModel
+                |> nextStepToEffect updatedModel
 
         GotBuildError buildError ->
             let
@@ -383,32 +346,29 @@ update execute msg model =
             in
             StaticResponses.nextStep
                 updatedModel
-                Nothing
-                |> nextStepToEffect execute updatedModel
+                |> nextStepToEffect updatedModel
 
 
 nextStepToEffect :
-    DataSource ()
-    -> Model
-    -> ( StaticResponses, StaticResponses.NextStep route )
+    Model
+    -> StaticResponses.NextStep route ()
     -> ( Model, Effect )
-nextStepToEffect execute model ( updatedStaticResponsesModel, nextStep ) =
+nextStepToEffect model nextStep =
     case nextStep of
-        StaticResponses.Continue updatedAllRawResponses httpRequests _ ->
+        StaticResponses.Continue httpRequests updatedStaticResponsesModel ->
             let
                 updatedModel : Model
                 updatedModel =
                     { model
-                        | allRawResponses = updatedAllRawResponses
+                        | allRawResponses = Encode.object []
                         , staticResponses = updatedStaticResponsesModel
                     }
             in
             if List.isEmpty httpRequests then
-                nextStepToEffect execute
+                nextStepToEffect
                     updatedModel
                     (StaticResponses.nextStep
                         updatedModel
-                        Nothing
                     )
 
             else
@@ -419,37 +379,17 @@ nextStepToEffect execute model ( updatedStaticResponsesModel, nextStep ) =
                     |> Effect.Batch
                 )
 
-        StaticResponses.Finish toJsPayload ->
-            case toJsPayload of
-                StaticResponses.ApiResponse ->
-                    let
-                        apiResponse : Effect
-                        apiResponse =
-                            StaticHttpRequest.resolve
-                                execute
-                                model.allRawResponses
-                                |> Result.mapError (StaticHttpRequest.toBuildError "TODO - path from request")
-                                |> (\response ->
-                                        case response of
-                                            Ok () ->
-                                                { body = Json.Encode.null
-                                                , staticHttpCache = Dict.empty
-                                                , statusCode = 200
-                                                }
-                                                    |> ToJsPayload.SendApiResponse
-                                                    |> Effect.SendSinglePage
-
-                                            Err error ->
-                                                [ error ]
-                                                    |> ToJsPayload.Errors
-                                                    |> Effect.SendSinglePage
-                                   )
-                    in
-                    ( model
-                    , apiResponse
-                    )
-
-                StaticResponses.Errors errors ->
-                    ( model
-                    , errors |> ToJsPayload.Errors |> Effect.SendSinglePage
-                    )
+        StaticResponses.Finish () ->
+            ( model
+            , { body = Encode.null
+              , staticHttpCache = Dict.empty
+              , statusCode = 200
+              }
+                |> ToJsPayload.SendApiResponse
+                |> Effect.SendSinglePage
+            )
+
+        StaticResponses.FinishedWithErrors buildErrors ->
+            ( model
+            , buildErrors |> ToJsPayload.Errors |> Effect.SendSinglePage
+            )