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

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

@@ -21,6 +21,7 @@ import Json.Decode as Decode
 import Json.Encode
 import PageServerResponse exposing (PageServerResponse)
 import Pages.Flags
+import Pages.Internal.FatalError
 import Pages.Internal.NotFoundReason as NotFoundReason exposing (NotFoundReason)
 import Pages.Internal.Platform.CompatibilityKey
 import Pages.Internal.Platform.Effect as Effect exposing (Effect)
@@ -677,6 +678,96 @@ initLegacy site ((RenderRequest.SinglePage includeHtml singleRequest _) as rende
                                                                     config.sharedData
                                                                     globalHeadTags
                                                     )
+                                                |> BackendTask.onError
+                                                    (\((Pages.Internal.FatalError.FatalError fatalError) as error) ->
+                                                        let
+                                                            isPreRendered : Bool
+                                                            isPreRendered =
+                                                                let
+                                                                    keys : Int
+                                                                    keys =
+                                                                        RenderRequest.maybeRequestPayload renderRequest |> Maybe.map (Decode.decodeValue (Decode.keyValuePairs Decode.value)) |> Maybe.withDefault (Ok []) |> Result.withDefault [] |> List.map Tuple.first |> List.length
+                                                                in
+                                                                -- TODO this is a bit hacky, would be nice to clean up the way of checking whether this is server-rendered or pre-rendered
+                                                                keys <= 1
+                                                        in
+                                                        if isDevServer || isPreRendered then
+                                                            -- we want to stop the build for pre-rendered routes, and give a dev server error popup in the dev server
+                                                            BackendTask.fail error
+
+                                                        else
+                                                            --only render the production ErrorPage in production server-rendered Routes
+                                                            config.sharedData
+                                                                |> BackendTask.andThen
+                                                                    (\justSharedData ->
+                                                                        let
+                                                                            errorPage : errorPage
+                                                                            errorPage =
+                                                                                config.internalError fatalError.body
+
+                                                                            dataThing : pageData
+                                                                            dataThing =
+                                                                                errorPage
+                                                                                    |> config.errorPageToData
+
+                                                                            statusCode : Int
+                                                                            statusCode =
+                                                                                config.errorStatusCode errorPage
+
+                                                                            byteEncodedPageData : Bytes
+                                                                            byteEncodedPageData =
+                                                                                ResponseSketch.HotUpdate
+                                                                                    dataThing
+                                                                                    justSharedData
+                                                                                    -- TODO remove shared action data
+                                                                                    Nothing
+                                                                                    |> config.encodeResponse
+                                                                                    |> Bytes.Encode.encode
+
+                                                                            pageModel : userModel
+                                                                            pageModel =
+                                                                                config.init
+                                                                                    Pages.Flags.PreRenderFlags
+                                                                                    justSharedData
+                                                                                    dataThing
+                                                                                    Nothing
+                                                                                    (Just
+                                                                                        { path =
+                                                                                            { path = currentPage.path
+                                                                                            , query = Nothing
+                                                                                            , fragment = Nothing
+                                                                                            }
+                                                                                        , metadata = currentPage.route
+                                                                                        , pageUrl = Nothing
+                                                                                        }
+                                                                                    )
+                                                                                    |> Tuple.first
+
+                                                                            currentPage : { path : Path, route : route }
+                                                                            currentPage =
+                                                                                { path = serverRequestPayload.path, route = urlToRoute config currentUrl }
+
+                                                                            viewValue : { title : String, body : List (Html (PagesMsg userMsg)) }
+                                                                            viewValue =
+                                                                                (config.view Dict.empty Dict.empty Nothing currentPage Nothing justSharedData dataThing Nothing |> .view)
+                                                                                    pageModel
+                                                                        in
+                                                                        { route = Path.toAbsolute currentPage.path
+                                                                        , contentJson = Dict.empty
+                                                                        , html = viewValue.body |> bodyToString
+                                                                        , errors = []
+                                                                        , head = [] -- TODO render head tags --config.view Dict.empty Dict.empty Nothing pathAndRoute Nothing justSharedData pageData Nothing |> .head
+                                                                        , title = viewValue.title
+                                                                        , staticHttpCache = Dict.empty
+                                                                        , is404 = False
+                                                                        , statusCode = statusCode
+                                                                        , headers = []
+                                                                        }
+                                                                            |> ToJsPayload.PageProgress
+                                                                            |> Effect.SendSinglePageNew byteEncodedPageData
+                                                                            |> BackendTask.succeed
+                                                                    )
+                                                    )
 
                                         Just notFoundReason ->
                                             render404Page config

package/src/Pages/Internal/Platform.elm

@@ -309,6 +309,7 @@ init config flags url key =
 type Msg userMsg pageData actionData sharedData errorPage
     = LinkClicked Browser.UrlRequest
     | UrlChanged Url
+      -- TODO rename to PagesMsg
     | UserMsg (PagesMsg userMsg)
     | SetField { formId : String, name : String, value : String }
     | UpdateCacheAndUrlNew Bool Url (Maybe userMsg) (Result Http.Error ( Url, ResponseSketch pageData actionData sharedData ))

package/src/Scaffold/Form.elm

@@ -1,6 +1,7 @@
 module Scaffold.Form exposing
     ( Kind(..), provide, restArgsParser
     , Context
+    , fieldEncoder, recordEncoder
     )
 
 {-|
@@ -9,12 +10,15 @@ module Scaffold.Form exposing
 
 @docs Context
 
+@docs fieldEncoder, recordEncoder
+
 -}
 
 import Cli.Option
 import Elm
 import Elm.Annotation as Type
 import Elm.Declare
+import Elm.Op
 import List.Extra
 import Result.Extra
 
@@ -59,84 +63,89 @@ formWithFields elmCssView fields viewFn =
                 |> List.foldl
                     (\( fieldName, kind ) chain ->
                         chain
-                            |> formField fieldName
-                                (case kind of
-                                    FieldText ->
-                                        formFieldText
-                                            |> formFieldRequired (Elm.string "Required")
+                            |> Elm.Op.pipe
+                                (formField fieldName
+                                    (case kind of
+                                        FieldText ->
+                                            formFieldText
+                                                |> Elm.Op.pipe (formFieldRequired (Elm.string "Required"))
+
+                                        FieldInt ->
+                                            formFieldInt { invalid = \_ -> Elm.string "" }
+                                                |> Elm.Op.pipe (formFieldRequired (Elm.string "Required"))
+
+                                        FieldTextarea ->
+                                            formFieldText
+                                                |> Elm.Op.pipe (formFieldRequired (Elm.string "Required"))
+                                                |> Elm.Op.pipe
+                                                    (formFieldTextarea
+                                                        { rows = Elm.nothing
+                                                        , cols = Elm.nothing
+                                                        }
+                                                    )
 
-                                    FieldInt ->
-                                        formFieldInt { invalid = \_ -> Elm.string "" }
-                                            |> formFieldRequired (Elm.string "Required")
+                                        FieldFloat ->
+                                            formFieldFloat { invalid = \_ -> Elm.string "" }
+                                                |> Elm.Op.pipe (formFieldRequired (Elm.string "Required"))
 
-                                    FieldTextarea ->
-                                        formFieldText
-                                            |> formFieldRequired (Elm.string "Required")
-                                            |> formFieldTextarea
-                                                { rows = Elm.nothing
-                                                , cols = Elm.nothing
-                                                }
-
-                                    FieldFloat ->
-                                        formFieldFloat { invalid = \_ -> Elm.string "" }
-                                            |> formFieldRequired (Elm.string "Required")
+                                        FieldTime ->
+                                            formFieldTime { invalid = \_ -> Elm.string "" }
+                                                |> Elm.Op.pipe (formFieldRequired (Elm.string "Required"))
 
-                                    FieldTime ->
-                                        formFieldTime { invalid = \_ -> Elm.string "" }
-                                            |> formFieldRequired (Elm.string "Required")
+                                        FieldDate ->
+                                            formFieldDate { invalid = \_ -> Elm.string "" }
+                                                |> Elm.Op.pipe (formFieldRequired (Elm.string "Required"))
 
-                                    FieldDate ->
-                                        formFieldDate { invalid = \_ -> Elm.string "" }
-                                            |> formFieldRequired (Elm.string "Required")
-
-                                    FieldCheckbox ->
-                                        formFieldCheckbox
+                                        FieldCheckbox ->
+                                            formFieldCheckbox
+                                    )
                                 )
                     )
-                    (formInit
-                        (Elm.function (List.map fieldToParam fields)
-                            (\params ->
-                                Elm.record
-                                    [ ( "combine"
-                                      , params
-                                            |> List.foldl
-                                                (\fieldExpression chain ->
-                                                    chain
-                                                        |> validationAndMap fieldExpression
-                                                )
-                                                (validationSucceed (Elm.val "ParsedForm"))
-                                      )
-                                    , ( "view"
-                                      , Elm.fn ( "formState", Nothing )
-                                            (\formState ->
-                                                let
-                                                    mappedParams : List { name : String, kind : Kind, param : Elm.Expression }
-                                                    mappedParams =
-                                                        params
-                                                            |> List.Extra.zip fields
-                                                            |> List.map
-                                                                (\( ( name, kind ), param ) ->
-                                                                    { name = name
-                                                                    , kind = kind
-                                                                    , param = param
-                                                                    }
-                                                                )
-                                                in
-                                                viewFn
-                                                    { formState =
-                                                        { errors = formState |> Elm.get "errors"
-                                                        , isTransitioning = formState |> Elm.get "isTransitioning"
-                                                        , submitAttempted = formState |> Elm.get "submitAttempted"
-                                                        , data = formState |> Elm.get "data"
-                                                        , expression = formState
-                                                        }
-                                                    , params = mappedParams
-                                                    }
+                    (Elm.function (List.map fieldToParam fields)
+                        (\params ->
+                            Elm.record
+                                [ ( "combine"
+                                  , params
+                                        |> List.foldl
+                                            (\fieldExpression chain ->
+                                                chain
+                                                    |> Elm.Op.pipe (validationAndMap fieldExpression)
                                             )
-                                      )
-                                    ]
-                            )
+                                            (Elm.val "ParsedForm"
+                                                |> Elm.Op.pipe validationSucceed
+                                            )
+                                  )
+                                , ( "view"
+                                  , Elm.fn ( "formState", Nothing )
+                                        (\formState ->
+                                            let
+                                                mappedParams : List { name : String, kind : Kind, param : Elm.Expression }
+                                                mappedParams =
+                                                    params
+                                                        |> List.Extra.zip fields
+                                                        |> List.map
+                                                            (\( ( name, kind ), param ) ->
+                                                                { name = name
+                                                                , kind = kind
+                                                                , param = param
+                                                                }
+                                                            )
+                                            in
+                                            viewFn
+                                                { formState =
+                                                    { errors = formState |> Elm.get "errors"
+                                                    , isTransitioning = formState |> Elm.get "isTransitioning"
+                                                    , submitAttempted = formState |> Elm.get "submitAttempted"
+                                                    , data = formState |> Elm.get "data"
+                                                    , expression = formState
+                                                    }
+                                                , params = mappedParams
+                                                }
+                                        )
+                                  )
+                                ]
                         )
+                        |> Elm.Op.pipe formInit
                     )
                 |> Elm.withType
                     (Type.namedWith [ "Form" ]
@@ -295,8 +304,8 @@ provide { fields, view, elmCssView } =
             }
 
 
-validationAndMap : Elm.Expression -> Elm.Expression -> Elm.Expression
-validationAndMap andMapArg andMapArg0 =
+validationAndMap : Elm.Expression -> Elm.Expression
+validationAndMap andMapArg =
     Elm.apply
         (Elm.value
             { importFrom = [ "Form", "Validation" ]
@@ -304,19 +313,16 @@ validationAndMap andMapArg andMapArg0 =
             , annotation = Nothing
             }
         )
-        [ andMapArg, andMapArg0 ]
+        [ andMapArg ]
 
 
-validationSucceed : Elm.Expression -> Elm.Expression
-validationSucceed succeedArg =
-    Elm.apply
-        (Elm.value
-            { importFrom = [ "Form", "Validation" ]
-            , name = "succeed"
-            , annotation = Nothing
-            }
-        )
-        [ succeedArg ]
+validationSucceed : Elm.Expression
+validationSucceed =
+    Elm.value
+        { importFrom = [ "Form", "Validation" ]
+        , name = "succeed"
+        , annotation = Nothing
+        }
 
 
 formFieldText : Elm.Expression
@@ -328,8 +334,8 @@ formFieldText =
         }
 
 
-formFieldRequired : Elm.Expression -> Elm.Expression -> Elm.Expression
-formFieldRequired requiredArg requiredArg0 =
+formFieldRequired : Elm.Expression -> Elm.Expression
+formFieldRequired requiredArg =
     Elm.apply
         (Elm.value
             { importFrom = [ "Form", "Field" ]
@@ -337,7 +343,7 @@ formFieldRequired requiredArg requiredArg0 =
             , annotation = Nothing
             }
         )
-        [ requiredArg, requiredArg0 ]
+        [ requiredArg ]
 
 
 formFieldInt : { invalid : Elm.Expression -> Elm.Expression } -> Elm.Expression
@@ -361,8 +367,7 @@ formFieldInt intArg =
 formFieldTextarea :
     { rows : Elm.Expression, cols : Elm.Expression }
     -> Elm.Expression
-    -> Elm.Expression
-formFieldTextarea textareaArg textareaArg0 =
+formFieldTextarea textareaArg =
     Elm.apply
         (Elm.value
             { importFrom = [ "Form", "Field" ]
@@ -374,7 +379,6 @@ formFieldTextarea textareaArg textareaArg0 =
             [ Tuple.pair "rows" textareaArg.rows
             , Tuple.pair "cols" textareaArg.cols
             ]
-        , textareaArg0
         ]
 
 
@@ -438,8 +442,8 @@ formFieldFloat floatArg =
         ]
 
 
-formField : String -> Elm.Expression -> Elm.Expression -> Elm.Expression
-formField fieldArg fieldArg0 fieldArg1 =
+formField : String -> Elm.Expression -> Elm.Expression
+formField fieldArg fieldArg0 =
     Elm.apply
         (Elm.value
             { importFrom = [ "Form" ]
@@ -447,29 +451,28 @@ formField fieldArg fieldArg0 fieldArg1 =
             , annotation = Nothing
             }
         )
-        [ Elm.string fieldArg, fieldArg0, fieldArg1 ]
+        [ Elm.string fieldArg, fieldArg0 ]
 
 
-formInit : Elm.Expression -> Elm.Expression
-formInit initArg =
-    Elm.apply
-        (Elm.value
-            { importFrom = [ "Form" ]
-            , name = "hiddenKind"
-            , annotation = Nothing
-            }
-        )
-        [ Elm.tuple (Elm.string "kind") (Elm.string "regular")
-        , Elm.string "Expected kind."
-        , Elm.apply
-            (Elm.value
-                { importFrom = [ "Form" ]
-                , name = "init"
-                , annotation = Nothing
-                }
+formInit : Elm.Expression
+formInit =
+    Elm.value
+        { importFrom = [ "Form" ]
+        , name = "init"
+        , annotation = Nothing
+        }
+        |> Elm.Op.pipe
+            (Elm.apply
+                (Elm.value
+                    { importFrom = [ "Form" ]
+                    , name = "hiddenKind"
+                    , annotation = Nothing
+                    }
+                )
+                [ Elm.tuple (Elm.string "kind") (Elm.string "regular")
+                , Elm.string "Expected kind."
+                ]
             )
-            [ initArg ]
-        ]
 
 
 initCombined : Elm.Expression -> Elm.Expression -> Elm.Expression
@@ -482,3 +485,76 @@ initCombined initCombinedArg initCombinedArg0 =
             }
         )
         [ initCombinedArg, initCombinedArg0 ]
+
+
+{-| Generate a JSON Encoder for the form fields. This can be helpful for sending the validated form data through a
+BackendTask.Custom or to an external API from your scaffolded Route Module code.
+-}
+recordEncoder : Elm.Expression -> List ( String, Kind ) -> Elm.Expression
+recordEncoder record fields =
+    fields
+        |> List.map
+            (\( field, kind ) ->
+                Elm.tuple
+                    (Elm.string field)
+                    (fieldEncoder record field kind)
+            )
+        |> Elm.list
+        |> List.singleton
+        |> Elm.apply
+            (Elm.value
+                { importFrom = [ "Json", "Encode" ]
+                , name = "object"
+                , annotation =
+                    Just
+                        (Type.function
+                            [ Type.list
+                                (Type.tuple
+                                    Type.string
+                                    (Type.namedWith [ "Json", "Encode" ] "Value" [])
+                                )
+                            ]
+                            (Type.namedWith [ "Json", "Encode" ] "Value" [])
+                        )
+                }
+            )
+
+
+{-| -}
+fieldEncoder : Elm.Expression -> String -> Kind -> Elm.Expression
+fieldEncoder record name kind =
+    Elm.apply
+        (case kind of
+            FieldInt ->
+                encoder "int"
+
+            FieldText ->
+                encoder "string"
+
+            FieldTextarea ->
+                encoder "string"
+
+            FieldFloat ->
+                encoder "float"
+
+            FieldTime ->
+                -- TODO fix time encoder
+                encoder "int"
+
+            FieldDate ->
+                -- TODO fix date encoder
+                encoder "int"
+
+            FieldCheckbox ->
+                encoder "bool"
+        )
+        [ Elm.get name record ]
+
+
+encoder : String -> Elm.Expression
+encoder name =
+    Elm.value
+        { importFrom = [ "Json", "Encode" ]
+        , name = name
+        , annotation = Nothing
+        }