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

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

@@ -12,7 +12,7 @@ import Bytes exposing (Bytes)
 import Bytes.Encode
 import Codec
 import Dict
-import Exception exposing (Throwable)
+import FatalError exposing (FatalError)
 import Head exposing (Tag)
 import Html exposing (Html)
 import HtmlPrinter
@@ -51,9 +51,8 @@ currentCompatibilityKey =
 
 {-| -}
 type alias Model route =
-    { staticResponses : BackendTask Throwable Effect
+    { staticResponses : BackendTask FatalError Effect
     , errors : List BuildError
-    , allRawResponses : RequestsAndPending
     , maybeRequestJson : RenderRequest route
     , isDevServer : Bool
     }
@@ -310,7 +309,6 @@ init site renderRequest config flags =
                           , path = ""
                           }
                         ]
-                    , allRawResponses = Json.Encode.object []
                     , maybeRequestJson = renderRequest
                     , isDevServer = False
                     }
@@ -325,7 +323,6 @@ init site renderRequest config flags =
                       , path = ""
                       }
                     ]
-                , allRawResponses = Json.Encode.object []
                 , maybeRequestJson = renderRequest
                 , isDevServer = False
                 }
@@ -379,11 +376,11 @@ initLegacy :
     -> ( Model route, Effect )
 initLegacy site ((RenderRequest.SinglePage includeHtml singleRequest _) as renderRequest) { isDevServer } config =
     let
-        globalHeadTags : BackendTask Throwable (List Tag)
+        globalHeadTags : BackendTask FatalError (List Tag)
         globalHeadTags =
             (config.globalHeadTags |> Maybe.withDefault (\_ -> BackendTask.succeed [])) HtmlPrinter.htmlToString
 
-        staticResponsesNew : BackendTask Throwable Effect
+        staticResponsesNew : BackendTask FatalError Effect
         staticResponsesNew =
             StaticResponses.renderApiRequest
                 (case singleRequest of
@@ -763,12 +760,11 @@ initLegacy site ((RenderRequest.SinglePage includeHtml singleRequest _) as rende
         initialModel =
             { staticResponses = staticResponsesNew
             , errors = []
-            , allRawResponses = Json.Encode.object []
             , maybeRequestJson = renderRequest
             , isDevServer = isDevServer
             }
     in
-    StaticResponses.nextStep initialModel
+    StaticResponses.nextStep (Json.Encode.object []) initialModel.staticResponses initialModel
         |> nextStepToEffect
             initialModel
 
@@ -777,7 +773,8 @@ updateAndSendPortIfDone :
     Model route
     -> ( Model route, Effect )
 updateAndSendPortIfDone model =
-    StaticResponses.nextStep
+    StaticResponses.nextStep (Json.Encode.object [])
+        model.staticResponses
         model
         |> nextStepToEffect model
 
@@ -790,15 +787,10 @@ update :
 update msg model =
     case msg of
         GotDataBatch batch ->
-            let
-                updatedModel : Model route
-                updatedModel =
-                    model
-                        |> StaticResponses.batchUpdate batch
-            in
-            StaticResponses.nextStep
-                updatedModel
-                |> nextStepToEffect updatedModel
+            StaticResponses.nextStep batch
+                model.staticResponses
+                model
+                |> nextStepToEffect model
 
         GotBuildError buildError ->
             let
@@ -809,7 +801,8 @@ update msg model =
                             buildError :: model.errors
                     }
             in
-            StaticResponses.nextStep
+            StaticResponses.nextStep (Json.Encode.object [])
+                updatedModel.staticResponses
                 updatedModel
                 |> nextStepToEffect updatedModel
 
@@ -821,27 +814,14 @@ nextStepToEffect :
 nextStepToEffect model nextStep =
     case nextStep of
         StaticResponses.Continue httpRequests updatedStaticResponsesModel ->
-            let
-                updatedModel : Model route
-                updatedModel =
-                    { model
-                        | staticResponses = updatedStaticResponsesModel
-                    }
-            in
-            if List.isEmpty httpRequests then
-                nextStepToEffect
-                    updatedModel
-                    (StaticResponses.nextStep
-                        updatedModel
-                    )
-
-            else
-                ( updatedModel
-                , (httpRequests
-                    |> List.map Effect.FetchHttp
-                  )
-                    |> Effect.Batch
-                )
+            ( { model
+                | staticResponses = updatedStaticResponsesModel
+              }
+            , (httpRequests
+                |> List.map Effect.FetchHttp
+              )
+                |> Effect.Batch
+            )
 
         StaticResponses.FinishedWithErrors errors ->
             ( model

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

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

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

@@ -11,7 +11,7 @@ import BuildError exposing (BuildError)
 import Cli.Program as Program exposing (FlagsIncludingArgv)
 import Codec
 import Dict
-import Exception exposing (Throwable)
+import FatalError exposing (FatalError)
 import HtmlPrinter
 import Json.Decode as Decode
 import Json.Encode as Encode
@@ -22,7 +22,6 @@ import Pages.Internal.Platform.StaticResponses as StaticResponses
 import Pages.Internal.Platform.ToJsPayload as ToJsPayload
 import Pages.Internal.Script
 import Pages.StaticHttp.Request
-import RequestsAndPending exposing (RequestsAndPending)
 import TerminalText as Terminal
 
 
@@ -34,10 +33,8 @@ type alias Flags =
 
 {-| -}
 type alias Model =
-    { staticResponses : BackendTask Throwable ()
+    { staticResponses : BackendTask FatalError ()
     , errors : List BuildError
-    , allRawResponses : RequestsAndPending
-    , done : Bool
     }
 
 
@@ -50,10 +47,10 @@ type Msg
 {-| -}
 app :
     GeneratorProgramConfig
-    -> Program.StatefulProgram Model Msg (BackendTask Throwable ()) Flags
+    -> Program.StatefulProgram Model Msg (BackendTask FatalError ()) Flags
 app config =
     let
-        cliConfig : Program.Config (BackendTask Throwable ())
+        cliConfig : Program.Config (BackendTask FatalError ())
         cliConfig =
             case config.data of
                 Pages.Internal.Script.Script theCliConfig ->
@@ -249,7 +246,7 @@ perform config effect =
 
 {-| -}
 init :
-    BackendTask Throwable ()
+    BackendTask FatalError ()
     -> FlagsIncludingArgv Flags
     -> ( Model, Effect )
 init execute flags =
@@ -281,17 +278,15 @@ init execute flags =
                   , path = ""
                   }
                 ]
-            , allRawResponses = Encode.object []
-            , done = False
             }
 
 
 initLegacy :
-    BackendTask Throwable ()
+    BackendTask FatalError ()
     -> ( Model, Effect )
 initLegacy execute =
     let
-        staticResponses : BackendTask Throwable ()
+        staticResponses : BackendTask FatalError ()
         staticResponses =
             StaticResponses.renderApiRequest execute
 
@@ -299,11 +294,9 @@ initLegacy execute =
         initialModel =
             { staticResponses = staticResponses
             , errors = []
-            , allRawResponses = Encode.object []
-            , done = False
             }
     in
-    StaticResponses.nextStep initialModel
+    StaticResponses.nextStep (Encode.object []) initialModel.staticResponses initialModel
         |> nextStepToEffect
             initialModel
 
@@ -312,7 +305,8 @@ updateAndSendPortIfDone :
     Model
     -> ( Model, Effect )
 updateAndSendPortIfDone model =
-    StaticResponses.nextStep
+    StaticResponses.nextStep (Encode.object [])
+        model.staticResponses
         model
         |> nextStepToEffect model
 
@@ -325,15 +319,10 @@ update :
 update msg model =
     case msg of
         GotDataBatch batch ->
-            let
-                updatedModel : Model
-                updatedModel =
-                    model
-                        |> StaticResponses.batchUpdate batch
-            in
-            StaticResponses.nextStep
-                updatedModel
-                |> nextStepToEffect updatedModel
+            StaticResponses.nextStep batch
+                model.staticResponses
+                model
+                |> nextStepToEffect model
 
         GotBuildError buildError ->
             let
@@ -344,7 +333,8 @@ update msg model =
                             buildError :: model.errors
                     }
             in
-            StaticResponses.nextStep
+            StaticResponses.nextStep (Encode.object [])
+                updatedModel.staticResponses
                 updatedModel
                 |> nextStepToEffect updatedModel
 
@@ -356,28 +346,14 @@ nextStepToEffect :
 nextStepToEffect model nextStep =
     case nextStep of
         StaticResponses.Continue httpRequests updatedStaticResponsesModel ->
-            let
-                updatedModel : Model
-                updatedModel =
-                    { model
-                        | allRawResponses = Encode.object []
-                        , staticResponses = updatedStaticResponsesModel
-                    }
-            in
-            if List.isEmpty httpRequests then
-                nextStepToEffect
-                    updatedModel
-                    (StaticResponses.nextStep
-                        updatedModel
-                    )
-
-            else
-                ( updatedModel
-                , (httpRequests
-                    |> List.map Effect.FetchHttp
-                  )
-                    |> Effect.Batch
-                )
+            ( { model
+                | staticResponses = updatedStaticResponsesModel
+              }
+            , (httpRequests
+                |> List.map Effect.FetchHttp
+              )
+                |> Effect.Batch
+            )
 
         StaticResponses.Finish () ->
             ( model

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

@@ -1,61 +1,48 @@
-module Pages.Internal.Platform.StaticResponses exposing (NextStep(..), batchUpdate, empty, nextStep, renderApiRequest)
+module Pages.Internal.Platform.StaticResponses exposing (NextStep(..), empty, nextStep, renderApiRequest)
 
 import BackendTask exposing (BackendTask)
 import BuildError exposing (BuildError)
-import Exception exposing (Catchable(..), Throwable)
-import Json.Decode as Decode
+import FatalError exposing (FatalError, Recoverable)
 import List.Extra
+import Pages.Internal.FatalError
 import Pages.StaticHttp.Request as HashRequest
 import Pages.StaticHttpRequest as StaticHttpRequest
 import RequestsAndPending exposing (RequestsAndPending)
 import TerminalText
 
 
-empty : a -> BackendTask Throwable a
+empty : a -> BackendTask FatalError a
 empty a =
     BackendTask.succeed a
 
 
 renderApiRequest :
-    BackendTask Throwable response
-    -> BackendTask Throwable response
+    BackendTask FatalError response
+    -> BackendTask FatalError response
 renderApiRequest request =
     request
 
 
-batchUpdate :
-    Decode.Value
-    ->
-        { model
-            | allRawResponses : Decode.Value
-        }
-    ->
-        { model
-            | allRawResponses : Decode.Value
-        }
-batchUpdate newEntries model =
-    { model | allRawResponses = newEntries }
-
-
 type NextStep route value
-    = Continue (List HashRequest.Request) (StaticHttpRequest.RawRequest Throwable value)
+    = Continue (List HashRequest.Request) (StaticHttpRequest.RawRequest FatalError value)
     | Finish value
     | FinishedWithErrors (List BuildError)
 
 
 nextStep :
-    { model
-        | staticResponses : BackendTask Throwable a
-        , errors : List BuildError
-        , allRawResponses : RequestsAndPending
-    }
+    RequestsAndPending
+    -> BackendTask FatalError a
+    ->
+        { model
+            | errors : List BuildError
+        }
     -> NextStep route a
-nextStep ({ allRawResponses, errors } as model) =
+nextStep allRawResponses staticResponses { errors } =
     let
-        staticRequestsStatus : StaticHttpRequest.Status Throwable a
+        staticRequestsStatus : StaticHttpRequest.Status FatalError a
         staticRequestsStatus =
             allRawResponses
-                |> StaticHttpRequest.cacheRequestResolution model.staticResponses
+                |> StaticHttpRequest.cacheRequestResolution staticResponses
 
         ( ( pendingRequests, completedValue ), urlsToPerform, progressedBackendTask ) =
             case staticRequestsStatus of
@@ -77,7 +64,7 @@ nextStep ({ allRawResponses, errors } as model) =
                 StaticHttpRequest.HasPermanentError _ ->
                     ( ( False, Nothing )
                     , []
-                    , BackendTask.fail (Exception.fromString "TODO this shouldn't happen")
+                    , BackendTask.fail (FatalError.fromString "TODO this shouldn't happen")
                     )
     in
     if pendingRequests then
@@ -125,7 +112,7 @@ nextStep ({ allRawResponses, errors } as model) =
                 Just (Ok completed) ->
                     Finish completed
 
-                Just (Err (Catchable () buildError)) ->
+                Just (Err (Pages.Internal.FatalError.FatalError buildError)) ->
                     FinishedWithErrors
                         [ { title = buildError.title |> String.toUpper
                           , path = "" -- TODO include path here

package/src/Pages/Internal/Script.elm

@@ -2,7 +2,7 @@ module Pages.Internal.Script exposing (Script(..))
 
 import BackendTask exposing (BackendTask)
 import Cli.Program as Program
-import Exception exposing (Throwable)
+import FatalError exposing (FatalError)
 import Html exposing (Html)
 
 
@@ -13,5 +13,5 @@ type Script
           -> Html Never
           -> String
          )
-         -> Program.Config (BackendTask Throwable ())
+         -> Program.Config (BackendTask FatalError ())
         )

package/src/Pages/Manifest.elm

@@ -68,7 +68,7 @@ import BackendTask exposing (BackendTask)
 import Color exposing (Color)
 import Color.Convert
 import Dict exposing (Dict)
-import Exception exposing (Throwable)
+import FatalError exposing (FatalError)
 import Head
 import Json.Encode as Encode
 import LanguageTag exposing (LanguageTag, emptySubtags)
@@ -345,7 +345,7 @@ nonEmptyList list =
 
 {-| A generator for Api.elm to include a manifest.json.
 -}
-generator : String -> BackendTask Throwable Config -> ApiRoute.ApiRoute ApiRoute.Response
+generator : String -> BackendTask FatalError Config -> ApiRoute.ApiRoute ApiRoute.Response
 generator canonicalSiteUrl config =
     ApiRoute.succeed
         (config

package/src/Pages/ProgramConfig.elm

@@ -7,7 +7,7 @@ import Bytes exposing (Bytes)
 import Bytes.Decode
 import Bytes.Encode
 import Dict exposing (Dict)
-import Exception exposing (Throwable)
+import FatalError exposing (FatalError)
 import Form.FormData exposing (FormData)
 import Head
 import Html exposing (Html)
@@ -49,9 +49,9 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
         -> ( userModel, effect )
     , update : Pages.FormState.PageFormState -> Dict String (Pages.Transition.FetcherState actionData) -> Maybe Pages.Transition.Transition -> sharedData -> pageData -> Maybe Browser.Navigation.Key -> userMsg -> userModel -> ( userModel, effect )
     , subscriptions : route -> Path -> userModel -> Sub userMsg
-    , sharedData : BackendTask Throwable sharedData
-    , data : Decode.Value -> route -> BackendTask Throwable (PageServerResponse pageData errorPage)
-    , action : Decode.Value -> route -> BackendTask Throwable (PageServerResponse actionData errorPage)
+    , sharedData : BackendTask FatalError sharedData
+    , data : Decode.Value -> route -> BackendTask FatalError (PageServerResponse pageData errorPage)
+    , action : Decode.Value -> route -> BackendTask FatalError (PageServerResponse actionData errorPage)
     , onActionData : actionData -> Maybe userMsg
     , view :
         Pages.FormState.PageFormState
@@ -69,8 +69,8 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
             { view : userModel -> { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }
             , head : List Head.Tag
             }
-    , handleRoute : route -> BackendTask Throwable (Maybe NotFoundReason)
-    , getStaticRoutes : BackendTask Throwable (List route)
+    , handleRoute : route -> BackendTask FatalError (Maybe NotFoundReason)
+    , getStaticRoutes : BackendTask FatalError (List route)
     , urlToRoute : Url -> route
     , routeToPath : route -> List String
     , site : Maybe SiteConfig
@@ -102,7 +102,7 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
     , encodeResponse : ResponseSketch pageData actionData sharedData -> Bytes.Encode.Encoder
     , encodeAction : actionData -> Bytes.Encode.Encoder
     , decodeResponse : Bytes.Decode.Decoder (ResponseSketch pageData actionData sharedData)
-    , globalHeadTags : Maybe ((Maybe { indent : Int, newLines : Bool } -> Html Never -> String) -> BackendTask Throwable (List Head.Tag))
+    , globalHeadTags : Maybe ((Maybe { indent : Int, newLines : Bool } -> Html Never -> String) -> BackendTask FatalError (List Head.Tag))
     , cmdToEffect : Cmd userMsg -> effect
     , perform :
         { fetchRouteData :

package/src/Pages/Script.elm

@@ -34,7 +34,7 @@ import BackendTask.Http
 import BackendTask.Internal.Request
 import Cli.OptionsParser as OptionsParser
 import Cli.Program as Program
-import Exception exposing (Catchable, Throwable)
+import FatalError exposing (FatalError, Recoverable)
 import Json.Decode as Decode
 import Json.Encode as Encode
 import Pages.Internal.Script
@@ -52,7 +52,7 @@ type Error
 
 
 {-| -}
-writeFile : { path : String, body : String } -> BackendTask (Catchable Error) ()
+writeFile : { path : String, body : String } -> BackendTask (Recoverable Error) ()
 writeFile { path, body } =
     BackendTask.Internal.Request.request
         { name = "write-file"
@@ -85,7 +85,7 @@ log message =
 
 
 {-| -}
-withoutCliOptions : BackendTask Throwable () -> Script
+withoutCliOptions : BackendTask FatalError () -> Script
 withoutCliOptions execute =
     Pages.Internal.Script.Script
         (\_ ->
@@ -100,7 +100,7 @@ withoutCliOptions execute =
 
 
 {-| -}
-withCliOptions : Program.Config cliOptions -> (cliOptions -> BackendTask Throwable ()) -> Script
+withCliOptions : Program.Config cliOptions -> (cliOptions -> BackendTask FatalError ()) -> Script
 withCliOptions config execute =
     Pages.Internal.Script.Script
         (\_ ->

package/src/Pages/SiteConfig.elm

@@ -1,11 +1,11 @@
 module Pages.SiteConfig exposing (SiteConfig)
 
 import BackendTask exposing (BackendTask)
-import Exception exposing (Throwable)
+import FatalError exposing (FatalError)
 import Head
 
 
 type alias SiteConfig =
     { canonicalUrl : String
-    , head : BackendTask Throwable (List Head.Tag)
+    , head : BackendTask FatalError (List Head.Tag)
     }

package/src/Pages/StaticHttpRequest.elm

@@ -65,7 +65,7 @@ cacheRequestResolution request rawResponses =
     case request of
         Request urlList lookupFn ->
             if List.isEmpty urlList then
-                cacheRequestResolutionHelp urlList rawResponses (lookupFn Nothing rawResponses)
+                cacheRequestResolution (lookupFn Nothing rawResponses) rawResponses
 
             else
                 Incomplete urlList (Request [] lookupFn)
@@ -78,25 +78,3 @@ type Status error value
     = Incomplete (List Pages.StaticHttp.Request.Request) (RawRequest error value)
     | HasPermanentError Error
     | Complete (Result error value)
-
-
-cacheRequestResolutionHelp :
-    List Pages.StaticHttp.Request.Request
-    -> RequestsAndPending
-    -> RawRequest error value
-    -> Status error value
-cacheRequestResolutionHelp foundUrls rawResponses request =
-    case request of
-        Request urlList lookupFn ->
-            if (urlList ++ foundUrls) |> List.isEmpty then
-                cacheRequestResolutionHelp
-                    []
-                    rawResponses
-                    (lookupFn Nothing rawResponses)
-
-            else
-                Incomplete (urlList ++ foundUrls)
-                    (Request [] lookupFn)
-
-        ApiRoute value ->
-            Complete value

package/src/Server/Request.elm

@@ -89,6 +89,7 @@ module Server.Request exposing
 import BackendTask exposing (BackendTask)
 import CookieParser
 import Dict exposing (Dict)
+import FatalError exposing (FatalError)
 import Form
 import Form.Validation as Validation
 import FormData
@@ -881,8 +882,8 @@ fileField_ name =
 
 {-| -}
 formDataWithServerValidation :
-    Form.ServerForms error (BackendTask error (Validation.Validation error combined kind constraints))
-    -> Parser (BackendTask error (Result (Form.Response error) ( Form.Response error, combined )))
+    Form.ServerForms error (BackendTask FatalError (Validation.Validation error combined kind constraints))
+    -> Parser (BackendTask FatalError (Result (Form.Response error) ( Form.Response error, combined )))
 formDataWithServerValidation formParsers =
     rawFormData
         |> andThen

package/src/Exception.elm

@@ -1,37 +0,0 @@
-module Exception exposing (Throwable, Catchable(..), fromString, fromStringWithValue, throw)
-
-{-|
-
-@docs Throwable, Catchable, fromString, fromStringWithValue, throw
-
--}
-
-
-{-| -}
-type alias Throwable =
-    Catchable ()
-
-
-{-| -}
-type Catchable error
-    = Catchable error { title : String, body : String }
-
-
-{-| -}
-fromString : String -> Catchable ()
-fromString string =
-    fromStringWithValue string ()
-
-
-{-| -}
-fromStringWithValue : String -> value -> Catchable value
-fromStringWithValue string value =
-    Catchable value { title = "Custom Error", body = string }
-
-
-{-| -}
-throw : Catchable error -> Catchable ()
-throw exception =
-    case exception of
-        Catchable _ string ->
-            Catchable () string

package/src/MultiDict.elm

@@ -1,49 +0,0 @@
-module MultiDict exposing (MultiDict, empty, get, insert, keys, remove, set)
-
-import Dict exposing (Dict)
-import List.Extra
-import List.Nonempty as NonEmpty
-
-
-type alias NonEmpty a =
-    NonEmpty.Nonempty a
-
-
-type MultiDict k v
-    = MultiDict (Dict k (NonEmpty v))
-
-
-empty : MultiDict k v
-empty =
-    MultiDict Dict.empty
-
-
-insert : comparable -> v -> MultiDict comparable v -> MultiDict comparable v
-insert key value (MultiDict dict) =
-    MultiDict
-        (Dict.update key (Maybe.map (NonEmpty.cons value) >> Maybe.withDefault (NonEmpty.fromElement value) >> Just) dict)
-
-
-get : comparable -> MultiDict comparable v -> List v
-get key (MultiDict dict) =
-    Dict.get key dict
-        |> Maybe.map NonEmpty.toList
-        |> Maybe.withDefault []
-
-
-keys : MultiDict k v -> List k
-keys (MultiDict dict) =
-    Dict.toList dict
-        |> List.concatMap (\( k, vs ) -> List.repeat (NonEmpty.length vs) k)
-
-
-remove : comparable -> v -> MultiDict comparable v -> MultiDict comparable v
-remove key value (MultiDict dict) =
-    MultiDict
-        (Dict.update key (Maybe.andThen (NonEmpty.toList >> List.Extra.remove value >> NonEmpty.fromList)) dict)
-
-
-set : comparable -> List v -> MultiDict comparable v -> MultiDict comparable v
-set key values (MultiDict dict) =
-    MultiDict
-        (Dict.update key (\_ -> NonEmpty.fromList values) dict)