elm-pages 3.0.0-beta.33 → 3.0.0-beta.35

package/src/BackendTask/Internal/Request.elm

@@ -1,7 +1,9 @@
-module BackendTask.Internal.Request exposing (request)
+module BackendTask.Internal.Request exposing (request, request2)
 
 import BackendTask exposing (BackendTask)
-import BackendTask.Http exposing (Body, Expect)
+import BackendTask.Http exposing (Body, Error(..), Expect)
+import Json.Decode exposing (Decoder)
+import Json.Encode as Encode
 
 
 request :
@@ -22,7 +24,50 @@ request ({ name, body, expect } as params) =
         }
         expect
         |> BackendTask.onError
-            (\_ ->
+            (\error ->
+                let
+                    _ =
+                        Debug.log "BackendTask.Internal.Request" error
+                in
                 -- TODO avoid crash here, this should be handled as an internal error
                 request params
             )
+
+
+request2 :
+    { name : String
+    , body : Body
+    , expect : Decoder a
+    , errorDecoder : Decoder error
+    , onError : Json.Decode.Error -> error
+    }
+    -> BackendTask error a
+request2 ({ name, body, expect, onError, errorDecoder } as params) =
+    -- elm-review: known-unoptimized-recursion
+    BackendTask.Http.request
+        { url = "elm-pages-internal://" ++ name
+        , method = "GET"
+        , headers = []
+        , body = body
+        , timeoutInMs = Nothing
+        , retries = Nothing
+        }
+        (BackendTask.Http.expectJson Json.Decode.value)
+        |> BackendTask.onError
+            (\error ->
+                BackendTask.succeed Encode.null
+            )
+        |> BackendTask.andThen
+            (\decodeValue ->
+                case Json.Decode.decodeValue errorDecoder decodeValue of
+                    Ok a ->
+                        BackendTask.fail a
+
+                    Err _ ->
+                        case Json.Decode.decodeValue expect decodeValue of
+                            Ok a ->
+                                BackendTask.succeed a
+
+                            Err e ->
+                                BackendTask.fail (onError e)
+            )

package/src/FatalError.elm

@@ -1,4 +1,4 @@
-module FatalError exposing (FatalError, fromString, recoverable)
+module FatalError exposing (FatalError, build, fromString, recoverable)
 
 {-| The Elm language doesn't have the concept of exceptions or special control flow for errors. It just has
 Custom Types, and by convention types like `Result` and the `Err` variant are used to represent possible failure states
@@ -54,7 +54,7 @@ issue.
 In the case of server-rendered Routes (`RouteBuilder.serverRender`), `elm-pages` will show your 500 error page
 when these errors occur.
 
-@docs FatalError, fromString, recoverable
+@docs FatalError, build, fromString, recoverable
 
 -}
 
@@ -66,7 +66,8 @@ type alias FatalError =
     Pages.Internal.FatalError.FatalError
 
 
-{-| -}
+{-| Create a FatalError with a title and body.
+-}
 build : { title : String, body : String } -> FatalError
 build info =
     Pages.Internal.FatalError.FatalError info

package/src/Internal/Field.elm

@@ -0,0 +1,19 @@
+module Internal.Field exposing (Field(..), FieldInfo)
+
+{-| -}
+
+import Json.Encode as Encode
+
+
+type Field error parsed input initial kind constraints
+    = Field (FieldInfo error parsed input initial) kind
+
+
+{-| -}
+type alias FieldInfo error parsed input initial =
+    { initialValue : input -> Maybe String
+    , decode : Maybe String -> ( Maybe parsed, List error )
+    , properties : List ( String, Encode.Value )
+    , initialToString : initial -> String
+    , compare : String -> initial -> Order
+    }

package/src/Internal/Input.elm

@@ -0,0 +1,81 @@
+module Internal.Input exposing
+    ( Hidden(..)
+    , Input(..)
+    , InputType(..)
+    , Options(..)
+    , inputTypeToString
+    )
+
+
+type InputType
+    = Text
+    | Number
+      -- TODO should range have arguments for initial, min, and max?
+    | Range
+    | Radio
+      -- TODO should submit be a special type, or an Input type?
+      -- TODO have an option for a submit with a name/value?
+    | Date
+    | Time
+    | Checkbox
+    | Tel
+    | Search
+    | Password
+    | Email
+    | Url
+    | Textarea { rows : Maybe Int, cols : Maybe Int }
+
+
+inputTypeToString : InputType -> String
+inputTypeToString inputType =
+    case inputType of
+        Text ->
+            "text"
+
+        Textarea _ ->
+            "text"
+
+        Number ->
+            "number"
+
+        Range ->
+            "range"
+
+        Radio ->
+            "radio"
+
+        Date ->
+            "date"
+
+        Time ->
+            "time"
+
+        Checkbox ->
+            "checkbox"
+
+        Tel ->
+            "tel"
+
+        Search ->
+            "search"
+
+        Password ->
+            "password"
+
+        Email ->
+            "email"
+
+        Url ->
+            "url"
+
+
+type Input
+    = Input InputType
+
+
+type Hidden
+    = Hidden
+
+
+type Options a
+    = Options (String -> Maybe a) (List String)

package/src/Pages/Form.elm

@@ -0,0 +1,229 @@
+module Pages.Form exposing
+    ( Strategy(..), renderHtml, renderStyledHtml
+    , FormWithServerValidations, Handler
+    )
+
+{-|
+
+@docs Strategy, renderHtml, renderStyledHtml
+
+@docs FormWithServerValidations, Handler
+
+-}
+
+import BackendTask exposing (BackendTask)
+import Dict exposing (Dict)
+import FatalError exposing (FatalError)
+import Form
+import Form.Handler
+import Form.Validation as Validation exposing (Validation)
+import Html
+import Html.Styled
+import Pages.Internal.Msg
+import Pages.Transition
+import PagesMsg exposing (PagesMsg)
+
+
+{-| -}
+type alias FormWithServerValidations error combined input view =
+    Form.Form
+        error
+        { combine :
+            Validation
+                error
+                (BackendTask FatalError (Validation error combined Never Never))
+                Never
+                Never
+        , view : Form.Context error input -> view
+        }
+        (BackendTask FatalError (Validation error combined Never Never))
+        input
+
+
+{-| -}
+type alias Handler error combined =
+    Form.Handler.Handler error (BackendTask FatalError (Validation.Validation error combined Never Never))
+
+
+{-| -}
+type Strategy
+    = Parallel
+    | Serial
+
+
+{-| -}
+renderHtml :
+    List (Html.Attribute (PagesMsg userMsg))
+    -> Strategy
+    -> Form.Options error parsed input userMsg
+    ->
+        { --path : Path
+          --, url : Maybe PageUrl
+          --, action : Maybe action
+          app
+            | pageFormState : Form.Model
+            , transition : Maybe Pages.Transition.Transition
+            , fetchers : Dict String (Pages.Transition.FetcherState (Maybe action))
+        }
+    -> Form.Form error { combine : Validation error parsed named constraints, view : Form.Context error input -> List (Html.Html (PagesMsg userMsg)) } parsed input
+    -> Html.Html (PagesMsg userMsg)
+renderHtml attrs strategy options_ app form_ =
+    form_
+        |> Form.renderHtml
+            { state = app.pageFormState
+            , submitting =
+                (case app.fetchers |> Dict.get options_.id of
+                    Just { status } ->
+                        case status of
+                            Pages.Transition.FetcherComplete _ ->
+                                False
+
+                            Pages.Transition.FetcherSubmitting ->
+                                True
+
+                            Pages.Transition.FetcherReloading _ ->
+                                True
+
+                    Nothing ->
+                        False
+                )
+                    || (case app.transition of
+                            Just (Pages.Transition.Submitting formData) ->
+                                formData.id == Just options_.id
+
+                            Just (Pages.Transition.LoadAfterSubmit submitData _ _) ->
+                                submitData.id == Just options_.id
+
+                            Just (Pages.Transition.Loading _ _) ->
+                                False
+
+                            Nothing ->
+                                False
+                       )
+            , toMsg = Pages.Internal.Msg.FormMsg
+            }
+            { id = options_.id
+            , method = options_.method
+            , input = options_.input
+            , serverResponse = options_.serverResponse
+            , action = options_.action
+            , onSubmit =
+                Just
+                    (\submission ->
+                        case submission.parsed of
+                            Form.Valid _ ->
+                                Pages.Internal.Msg.Submit
+                                    { useFetcher = strategy == Parallel
+                                    , action = submission.action
+                                    , fields = submission.fields
+                                    , method = submission.method
+                                    , msg =
+                                        options_.onSubmit
+                                            |> Maybe.map
+                                                (\onSubmit -> onSubmit submission)
+                                    , id = options_.id
+                                    , valid = True
+                                    }
+
+                            Form.Invalid _ _ ->
+                                Pages.Internal.Msg.Submit
+                                    { useFetcher = strategy == Parallel
+                                    , action = submission.action
+                                    , method = submission.method
+                                    , fields = submission.fields
+                                    , msg = options_.onSubmit |> Maybe.map (\onSubmit -> onSubmit submission)
+                                    , id = options_.id
+                                    , valid = False
+                                    }
+                    )
+            }
+            attrs
+
+
+{-| -}
+renderStyledHtml :
+    List (Html.Styled.Attribute (PagesMsg userMsg))
+    -> Strategy
+    -> Form.Options error parsed input userMsg
+    ->
+        { --path : Path
+          --, url : Maybe PageUrl
+          --, action : Maybe action
+          app
+            | pageFormState : Form.Model
+            , transition : Maybe Pages.Transition.Transition
+            , fetchers : Dict String (Pages.Transition.FetcherState (Maybe action))
+        }
+    -> Form.Form error { combine : Validation error parsed named constraints, view : Form.Context error input -> List (Html.Styled.Html (PagesMsg userMsg)) } parsed input
+    -> Html.Styled.Html (PagesMsg userMsg)
+renderStyledHtml attrs strategy options_ app form_ =
+    form_
+        |> Form.renderStyledHtml
+            { state = app.pageFormState
+            , toMsg = Pages.Internal.Msg.FormMsg
+            , submitting =
+                (case app.fetchers |> Dict.get options_.id of
+                    Just { status } ->
+                        case status of
+                            Pages.Transition.FetcherComplete _ ->
+                                False
+
+                            Pages.Transition.FetcherSubmitting ->
+                                True
+
+                            Pages.Transition.FetcherReloading _ ->
+                                True
+
+                    Nothing ->
+                        False
+                )
+                    || (case app.transition of
+                            Just (Pages.Transition.Submitting formData) ->
+                                formData.id == Just options_.id
+
+                            Just (Pages.Transition.LoadAfterSubmit submitData _ _) ->
+                                submitData.id == Just options_.id
+
+                            Just (Pages.Transition.Loading _ _) ->
+                                False
+
+                            Nothing ->
+                                False
+                       )
+            }
+            { id = options_.id
+            , method = options_.method
+            , input = options_.input
+            , serverResponse = options_.serverResponse
+            , action = options_.action
+            , onSubmit =
+                Just
+                    (\submission ->
+                        case submission.parsed of
+                            Form.Valid _ ->
+                                Pages.Internal.Msg.Submit
+                                    { useFetcher = strategy == Parallel
+                                    , action = submission.action
+                                    , fields = submission.fields
+                                    , method = submission.method
+                                    , msg =
+                                        options_.onSubmit
+                                            |> Maybe.map
+                                                (\onSubmit -> onSubmit submission)
+                                    , id = options_.id
+                                    , valid = True
+                                    }
+
+                            Form.Invalid _ _ ->
+                                Pages.Internal.Msg.Submit
+                                    { useFetcher = strategy == Parallel
+                                    , action = submission.action
+                                    , fields = submission.fields
+                                    , method = submission.method
+                                    , msg = options_.onSubmit |> Maybe.map (\onSubmit -> onSubmit submission)
+                                    , id = options_.id
+                                    , valid = False
+                                    }
+                    )
+            }
+            attrs

package/src/Pages/Internal/Msg.elm

@@ -1,13 +1,17 @@
 module Pages.Internal.Msg exposing
-    ( Msg(..)
-    , fetcherOnSubmit
-    , map
-    , onSubmit
-    , submitIfValid
+    (  Msg(..)
+       --, fetcherOnSubmit
+
+    ,  map
+       --, onSubmit
+       --, submitIfValid
+
     )
 
-import Form.FormData exposing (FormData)
-import FormDecoder
+--import Form.FormData exposing (FormData)
+--import FormDecoder
+
+import Form exposing (Method)
 import Html exposing (Attribute)
 import Html.Attributes as Attr
 import Json.Decode
@@ -16,54 +20,56 @@ import Json.Decode
 {-| -}
 type Msg userMsg
     = UserMsg userMsg
-    | Submit FormData
-    | SubmitIfValid String FormData Bool (Maybe userMsg)
-    | SubmitFetcher String FormData Bool (Maybe userMsg)
-    | FormFieldEvent Json.Decode.Value
+    | Submit { valid : Bool, method : Method, action : String, fields : List ( String, String ), id : String, msg : Maybe userMsg, useFetcher : Bool }
+      --| SubmitIfValid String FormData Bool (Maybe userMsg)
+      --| SubmitFetcher String FormData Bool (Maybe userMsg)
+    | FormMsg (Form.Msg (Msg userMsg))
     | NoOp
 
 
-{-| -}
-onSubmit : Attribute (Msg userMsg)
-onSubmit =
-    FormDecoder.formDataOnSubmit
-        |> Attr.map Submit
-
-
-{-| -}
-submitIfValid : Maybe ({ fields : List ( String, String ) } -> userMsg) -> String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
-submitIfValid userMsg formId isValid =
-    FormDecoder.formDataOnSubmit
-        |> Attr.map
-            (\formData ->
-                SubmitIfValid formId
-                    formData
-                    (isValid formData.fields)
-                    (userMsg
-                        |> Maybe.map
-                            (\toUserMsg ->
-                                toUserMsg { fields = formData.fields }
-                            )
-                    )
-            )
-
 
-{-| -}
-fetcherOnSubmit : Maybe ({ fields : List ( String, String ) } -> userMsg) -> String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
-fetcherOnSubmit userMsg formId isValid =
-    FormDecoder.formDataOnSubmit
-        |> Attr.map
-            (\formData ->
-                SubmitFetcher formId
-                    formData
-                    (isValid formData.fields)
-                    (userMsg
-                        |> Maybe.map
-                            (\toUserMsg ->
-                                toUserMsg { fields = formData.fields }
-                            )
-                    )
-            )
+--{-| -}
+--onSubmit : Attribute (Msg userMsg)
+--onSubmit =
+--    FormDecoder.formDataOnSubmit
+--        |> Attr.map Submit
+--
+--
+--{-| -}
+--submitIfValid : Maybe ({ fields : List ( String, String ) } -> userMsg) -> String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
+--submitIfValid userMsg formId isValid =
+--    FormDecoder.formDataOnSubmit
+--        |> Attr.map
+--            (\formData ->
+--                SubmitIfValid formId
+--                    formData
+--                    (isValid formData.fields)
+--                    (userMsg
+--                        |> Maybe.map
+--                            (\toUserMsg ->
+--                                toUserMsg { fields = formData.fields }
+--                            )
+--                    )
+--            )
+--
+--
+--
+--{-| -}
+--fetcherOnSubmit : Maybe ({ fields : List ( String, String ) } -> userMsg) -> String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
+--fetcherOnSubmit userMsg formId isValid =
+--    FormDecoder.formDataOnSubmit
+--        |> Attr.map
+--            (\formData ->
+--                SubmitFetcher formId
+--                    formData
+--                    (isValid formData.fields)
+--                    (userMsg
+--                        |> Maybe.map
+--                            (\toUserMsg ->
+--                                toUserMsg { fields = formData.fields }
+--                            )
+--                    )
+--            )
 
 
 {-| -}
@@ -74,16 +80,19 @@ map mapFn msg =
             UserMsg (mapFn userMsg)
 
         Submit info ->
-            Submit info
-
-        SubmitIfValid formId info isValid toUserMsg ->
-            SubmitIfValid formId info isValid (Maybe.map mapFn toUserMsg)
-
-        SubmitFetcher formId info isValid toUserMsg ->
-            SubmitFetcher formId info isValid (Maybe.map mapFn toUserMsg)
-
-        FormFieldEvent value ->
-            FormFieldEvent value
+            Submit
+                { valid = info.valid
+                , fields = info.fields
+                , action = info.action
+                , id = info.id
+                , msg = Maybe.map mapFn info.msg
+                , method = info.method
+                , useFetcher = info.useFetcher
+                }
+
+        FormMsg value ->
+            FormMsg
+                (Form.mapMsg (map mapFn) value)
 
         NoOp ->
             NoOp