diff --git a/examples/blog-engine/app/Effect.elm b/examples/blog-engine/app/Effect.elm index ee89c0a1..351ede00 100644 --- a/examples/blog-engine/app/Effect.elm +++ b/examples/blog-engine/app/Effect.elm @@ -1,7 +1,6 @@ module Effect exposing (Effect(..), batch, fromCmd, map, none, perform) import Browser.Navigation -import Form.FormData exposing (FormData) import Http import Json.Decode as Decode import Pages.Fetcher @@ -13,14 +12,14 @@ type Effect msg | Cmd (Cmd msg) | Batch (List (Effect msg)) | SetField { formId : String, name : String, value : String } - | FetchRouteData - { data : Maybe FormData - , toMsg : Result Http.Error Url -> msg - } - | Submit - { values : FormData - , toMsg : Result Http.Error Url -> msg - } + --| FetchRouteData + -- { data : Maybe FormData + -- , toMsg : Result Http.Error Url -> msg + -- } + --| Submit + -- { values : FormData + -- , toMsg : Result Http.Error Url -> msg + -- } | SubmitFetcher (Pages.Fetcher.Fetcher msg) @@ -57,18 +56,17 @@ map fn effect = Batch list -> Batch (List.map (map fn) list) - FetchRouteData fetchInfo -> - FetchRouteData - { data = fetchInfo.data - , toMsg = fetchInfo.toMsg >> fn - } - - Submit fetchInfo -> - Submit - { values = fetchInfo.values - , toMsg = fetchInfo.toMsg >> fn - } - + --FetchRouteData fetchInfo -> + -- FetchRouteData + -- { data = fetchInfo.data + -- , toMsg = fetchInfo.toMsg >> fn + -- } + -- + --Submit fetchInfo -> + -- Submit + -- { values = fetchInfo.values + -- , toMsg = fetchInfo.toMsg >> fn + -- } SetField info -> SetField info @@ -80,12 +78,12 @@ map fn effect = perform : { fetchRouteData : - { data : Maybe FormData + { data : Maybe a , toMsg : Result Http.Error Url -> pageMsg } -> Cmd msg , submit : - { values : FormData + { values : b , toMsg : Result Http.Error Url -> pageMsg } -> Cmd msg @@ -112,12 +110,11 @@ perform ({ fromPageMsg, key } as helpers) effect = Batch list -> Cmd.batch (List.map (perform helpers) list) - FetchRouteData fetchInfo -> - helpers.fetchRouteData - fetchInfo - - Submit record -> - helpers.submit record - + --FetchRouteData fetchInfo -> + -- helpers.fetchRouteData + -- fetchInfo + -- + --Submit record -> + -- helpers.submit record SubmitFetcher record -> helpers.runFetcher record diff --git a/examples/blog-engine/app/Route/Admin/Slug_.elm b/examples/blog-engine/app/Route/Admin/Slug_.elm index 254fabc4..e8784cc1 100644 --- a/examples/blog-engine/app/Route/Admin/Slug_.elm +++ b/examples/blog-engine/app/Route/Admin/Slug_.elm @@ -152,21 +152,23 @@ view app shared model = , body = [ Html.h2 [] [ Html.text "Form" ] , form - |> Pages.Form.renderHtml "form" - [] - --(Just << .errors) + |> Pages.Form.renderHtml [] + Pages.Form.Serial + (Form.options "form" + |> Form.withInput app.data.post + |> Form.withServerResponse + (app.action |> Maybe.map .errors) + ) app - app.data.post , if app.routeParams.slug == "new" then Html.text "" else deleteForm - |> Pages.Form.renderHtml "delete" - [] - --(\_ -> Nothing) + |> Pages.Form.renderHtml [] + Pages.Form.Serial + (Form.options "delete") app - () ] } diff --git a/examples/blog-engine/elm.json b/examples/blog-engine/elm.json index 5d19e41e..ed039c91 100644 --- a/examples/blog-engine/elm.json +++ b/examples/blog-engine/elm.json @@ -19,6 +19,7 @@ "dillonkearns/elm-bcp47-language-tag": "1.0.1", "dillonkearns/elm-cli-options-parser": "3.2.0", "dillonkearns/elm-date-or-date-time": "2.0.0", + "dillonkearns/elm-form": "2.0.2", "dillonkearns/elm-graphql": "5.0.11", "dillonkearns/elm-markdown": "7.0.1", "elm/browser": "1.0.2", diff --git a/examples/end-to-end/app/Route/Hello.elm b/examples/end-to-end/app/Route/Hello.elm deleted file mode 100644 index db0f51de..00000000 --- a/examples/end-to-end/app/Route/Hello.elm +++ /dev/null @@ -1,77 +0,0 @@ -module Route.Hello exposing (ActionData, Data, Model, Msg, route) - -import BackendTask exposing (BackendTask) -import ErrorPage exposing (ErrorPage) -import FatalError exposing (FatalError) -import Head -import Head.Seo as Seo -import Pages.Url -import PagesMsg exposing (PagesMsg) -import RouteBuilder exposing (App, StatefulRoute, StatelessRoute) -import Server.Request as Request -import Server.Response as Response exposing (Response) -import Shared -import View exposing (View) - - -type alias Model = - {} - - -type alias Msg = - () - - -type alias RouteParams = - {} - - -type alias ActionData = - {} - - -route : StatelessRoute RouteParams Data ActionData -route = - RouteBuilder.serverRender - { head = head - , data = data - , action = \_ -> Request.skip "" - } - |> RouteBuilder.buildNoState { view = view } - - -type alias Data = - {} - - -data : RouteParams -> Request.Parser (BackendTask FatalError (Response Data ErrorPage)) -data routeParams = - Request.succeed (BackendTask.succeed (Response.render Data)) - - -head : - App Data ActionData RouteParams - -> List Head.Tag -head app = - Seo.summary - { canonicalUrlOverride = Nothing - , siteName = "elm-pages" - , image = - { url = Pages.Url.external "TODO" - , alt = "elm-pages logo" - , dimensions = Nothing - , mimeType = Nothing - } - , description = "TODO" - , locale = Nothing - , title = "TODO title" -- metadata.title -- TODO - } - |> Seo.website - - -view : - App Data ActionData RouteParams - -> Shared.Model - -> View (PagesMsg Msg) -view app shared = - View.placeholder "Hello" diff --git a/examples/end-to-end/codegen/elm.codegen.json b/examples/end-to-end/codegen/elm.codegen.json index 0a693cbc..0487f154 100644 --- a/examples/end-to-end/codegen/elm.codegen.json +++ b/examples/end-to-end/codegen/elm.codegen.json @@ -3,6 +3,7 @@ "codegen-helpers": { "packages": { "elm/core": "1.0.5", + "elm/json": "1.1.3", "elm/html": "1.0.0", "rtfeldman/elm-css": "18.0.0" }, diff --git a/examples/end-to-end/script/elm.json b/examples/end-to-end/script/elm.json index 6c29203a..72dce519 100644 --- a/examples/end-to-end/script/elm.json +++ b/examples/end-to-end/script/elm.json @@ -15,7 +15,7 @@ "dillonkearns/elm-bcp47-language-tag": "1.0.1", "dillonkearns/elm-cli-options-parser": "3.2.0", "dillonkearns/elm-date-or-date-time": "2.0.0", - "dillonkearns/elm-markdown": "7.0.0", + "dillonkearns/elm-markdown": "7.0.1", "elm/browser": "1.0.2", "elm/bytes": "1.0.8", "elm/core": "1.0.5", @@ -28,11 +28,11 @@ "elm/url": "1.0.0", "elm/virtual-dom": "1.0.3", "elm-community/dict-extra": "2.4.0", - "elm-community/list-extra": "8.6.0", + "elm-community/list-extra": "8.7.0", "jluckyiv/elm-utc-date-strings": "1.0.0", "justinmimbs/date": "4.0.1", "matheus23/elm-default-tailwind-modules": "2.0.3", - "mdgriffith/elm-codegen": "2.0.0", + "mdgriffith/elm-codegen": "3.0.0", "miniBill/elm-codec": "2.0.0", "noahzgordon/elm-color-extra": "1.0.2", "pablohirafuji/elm-syntax-highlight": "3.4.1", @@ -43,7 +43,7 @@ "the-sett/elm-pretty-printer": "3.0.0", "the-sett/elm-syntax-dsl": "6.0.2", "tripokey/elm-fuzzy": "5.2.1", - "turboMaCk/non-empty-list-alias": "1.3.0", + "turboMaCk/non-empty-list-alias": "1.3.1", "vito/elm-ansi": "10.0.1", "zwilias/json-decode-exploration": "6.0.0" }, @@ -56,7 +56,7 @@ "elm-community/maybe-extra": "5.3.0", "fredcy/elm-parseint": "2.0.1", "mgold/elm-nonempty-list": "4.2.0", - "miniBill/elm-unicode": "1.0.2", + "miniBill/elm-unicode": "1.0.3", "rtfeldman/elm-hex": "1.0.0", "stil4m/elm-syntax": "7.2.9", "stil4m/structured-writer": "1.0.3" @@ -66,4 +66,4 @@ "direct": {}, "indirect": {} } -} \ No newline at end of file +} diff --git a/examples/end-to-end/script/src/AddRoute.elm b/examples/end-to-end/script/src/AddRoute.elm new file mode 100644 index 00000000..1d0eb753 --- /dev/null +++ b/examples/end-to-end/script/src/AddRoute.elm @@ -0,0 +1,292 @@ +module AddRoute exposing (run) + +import BackendTask +import Cli.Option as Option +import Cli.OptionsParser as OptionsParser +import Cli.Program as Program +import Elm +import Elm.Annotation as Type +import Elm.Case +import Elm.Declare +import Elm.Let +import Elm.Op +import Gen.BackendTask +import Gen.Effect as Effect +import Gen.Form as Form +import Gen.Form.FieldView as FieldView +import Gen.Html as Html +import Gen.Html.Attributes as Attr +import Gen.Json.Encode +import Gen.List +import Gen.Pages.Script +import Gen.Platform.Sub +import Gen.Server.Request as Request +import Gen.Server.Response as Response +import Gen.View +import Pages.Script as Script exposing (Script) +import Scaffold.Form +import Scaffold.Route exposing (Type(..)) + + +type alias CliOptions = + { moduleName : List String + , fields : List ( String, Scaffold.Form.Kind ) + } + + +run : Script +run = + Script.withCliOptions program + (\cliOptions -> + cliOptions + |> createFile + |> Script.writeFile + |> BackendTask.allowFatal + ) + + +program : Program.Config CliOptions +program = + Program.config + |> Program.add + (OptionsParser.build CliOptions + |> OptionsParser.with (Option.requiredPositionalArg "module" |> Scaffold.Route.moduleNameCliArg) + |> OptionsParser.withRestArgs Scaffold.Form.restArgsParser + ) + + +createFile : CliOptions -> { path : String, body : String } +createFile { moduleName, fields } = + let + formHelpers : + Maybe + { formHandlers : Elm.Expression + , form : Elm.Expression + , declarations : List Elm.Declaration + } + formHelpers = + Scaffold.Form.provide + { fields = fields + , elmCssView = False + , view = + \{ formState, params } -> + Elm.Let.letIn + (\fieldView -> + Elm.list + ((params + |> List.map + (\{ name, kind, param } -> + fieldView (Elm.string name) param + ) + ) + ++ [ Elm.ifThen formState.submitting + (Html.button + [ Attr.disabled True + ] + [ Html.text "Submitting..." + ] + ) + (Html.button [] + [ Html.text "Submit" + ] + ) + ] + ) + ) + |> Elm.Let.fn2 "fieldView" + ( "label", Type.string |> Just ) + ( "field", Nothing ) + (\label field -> + Html.div [] + [ Html.label [] + [ Html.call_.text (Elm.Op.append label (Elm.string " ")) + , field |> FieldView.input [] + , errorsView.call formState.errors field + ] + ] + ) + |> Elm.Let.toExpression + } + in + Scaffold.Route.serverRender + { moduleName = moduleName + , action = + ( Alias + (Type.record + (case formHelpers of + Just _ -> + [ ( "errors", Type.namedWith [ "Form" ] "ServerResponse" [ Type.string ] ) + ] + + Nothing -> + [] + ) + ) + , \routeParams -> + formHelpers + |> Maybe.map + (\justFormHelp -> + Request.formData justFormHelp.formHandlers + |> Request.call_.map + (Elm.fn ( "formData", Nothing ) + (\formData -> + Elm.Case.tuple formData + "response" + "parsedForm" + (\response parsedForm -> + Elm.Case.result parsedForm + { err = + ( "error" + , \error -> + "Form validations did not succeed!" + |> Gen.Pages.Script.log + |> Gen.BackendTask.call_.map + (Elm.fn ( "_", Nothing ) + (\_ -> + Response.render + (Elm.record + [ ( "errors", response ) + ] + ) + ) + ) + ) + , ok = + ( "validatedForm" + , \validatedForm -> + Scaffold.Form.recordEncoder validatedForm fields + |> Gen.Json.Encode.encode 2 + |> Gen.Pages.Script.call_.log + |> Gen.BackendTask.call_.map + (Elm.fn ( "_", Nothing ) + (\_ -> + Response.render + (Elm.record + [ ( "errors", response ) + ] + ) + ) + ) + ) + } + ) + ) + ) + ) + |> Maybe.withDefault + (Request.succeed + (Gen.BackendTask.succeed + (Response.render + (Elm.record []) + ) + ) + ) + ) + , data = + ( Alias (Type.record []) + , \routeParams -> + Request.succeed + (Gen.BackendTask.succeed + (Response.render + (Elm.record []) + ) + ) + ) + , head = \app -> Elm.list [] + } + |> Scaffold.Route.addDeclarations + (formHelpers + |> Maybe.map .declarations + |> Maybe.map ((::) errorsView.declaration) + |> Maybe.withDefault [] + ) + |> Scaffold.Route.buildWithLocalState + { view = + \{ shared, model, app } -> + Gen.View.make_.view + { title = moduleName |> String.join "." |> Elm.string + , body = + Elm.list + (case formHelpers of + Just justFormHelp -> + [ Html.h2 [] [ Html.text "Form" ] + , justFormHelp.form + |> Form.renderHtml "form" [] (Elm.get "errors" >> Elm.just) app Elm.unit + ] + + Nothing -> + [ Html.h2 [] [ Html.text "New Page" ] + ] + ) + } + , update = + \{ shared, app, msg, model } -> + Elm.Case.custom msg + (Type.named [] "Msg") + [ Elm.Case.branch0 "NoOp" + (Elm.tuple model + Effect.none + ) + ] + , init = + \{ shared, app } -> + Elm.tuple (Elm.record []) Effect.none + , subscriptions = + \{ routeParams, path, shared, model } -> + Gen.Platform.Sub.none + , model = + Alias (Type.record []) + , msg = + Custom [ Elm.variant "NoOp" ] + } + + +errorsView : + { declaration : Elm.Declaration + , call : Elm.Expression -> Elm.Expression -> Elm.Expression + , callFrom : List String -> Elm.Expression -> Elm.Expression -> Elm.Expression + , value : List String -> Elm.Expression + } +errorsView = + Elm.Declare.fn2 "errorsView" + ( "errors", Type.namedWith [ "Form" ] "Errors" [ Type.string ] |> Just ) + ( "field" + , Type.namedWith [ "Form", "Validation" ] + "Field" + [ Type.string + , Type.var "parsed" + , Type.var "kind" + ] + |> Just + ) + (\errors field -> + Elm.ifThen + (Gen.List.call_.isEmpty (Form.errorsForField field errors)) + (Html.div [] []) + (Html.div + [] + [ Html.call_.ul (Elm.list []) + (Gen.List.call_.map + (Elm.fn ( "error", Nothing ) + (\error -> + Html.li + [ Attr.style "color" "red" + ] + [ Html.call_.text error + ] + ) + ) + (Form.errorsForField field errors) + ) + ] + ) + |> Elm.withType + (Type.namedWith [ "Html" ] + "Html" + [ Type.namedWith + [ "PagesMsg" ] + "PagesMsg" + [ Type.named [] "Msg" ] + ] + ) + ) diff --git a/src/Scaffold/Form.elm b/src/Scaffold/Form.elm index 8a43961e..2c26ffef 100644 --- a/src/Scaffold/Form.elm +++ b/src/Scaffold/Form.elm @@ -37,14 +37,14 @@ type Kind {-| -} type alias Context = { errors : Elm.Expression - , isTransitioning : Elm.Expression + , submitting : Elm.Expression , submitAttempted : Elm.Expression , data : Elm.Expression , expression : Elm.Expression } -formWithFields : Bool -> List ( String, Kind ) -> ({ formState : { errors : Elm.Expression, isTransitioning : Elm.Expression, submitAttempted : Elm.Expression, data : Elm.Expression, expression : Elm.Expression }, params : List { name : String, kind : Kind, param : Elm.Expression } } -> Elm.Expression) -> { declaration : Elm.Declaration, call : List Elm.Expression -> Elm.Expression, callFrom : List String -> List Elm.Expression -> Elm.Expression, value : List String -> Elm.Expression } +formWithFields : Bool -> List ( String, Kind ) -> ({ formState : { errors : Elm.Expression, submitting : Elm.Expression, submitAttempted : Elm.Expression, data : Elm.Expression, expression : Elm.Expression }, params : List { name : String, kind : Kind, param : Elm.Expression } } -> Elm.Expression) -> { declaration : Elm.Declaration, call : List Elm.Expression -> Elm.Expression, callFrom : List String -> List Elm.Expression -> Elm.Expression, value : List String -> Elm.Expression } formWithFields elmCssView fields viewFn = Elm.Declare.function "form" [] @@ -124,7 +124,7 @@ formWithFields elmCssView fields viewFn = viewFn { formState = { errors = formState |> Elm.get "errors" - , isTransitioning = formState |> Elm.get "isTransitioning" + , submitting = formState |> Elm.get "submitting" , submitAttempted = formState |> Elm.get "submitAttempted" , data = formState |> Elm.get "data" , expression = formState @@ -148,7 +148,7 @@ formWithFields elmCssView fields viewFn = [ Type.string , Type.named [] "ParsedForm" , Type.var "input" - , Type.named [] "Msg" + , Type.namedWith [ "PagesMsg" ] "PagesMsg" [ Type.named [] "Msg" ] ] ) ) @@ -237,8 +237,8 @@ provide { fields, view, elmCssView } = (\_ -> initCombined (Elm.val "Action") (form.call []) |> Elm.withType - (Type.namedWith [ "Form" ] - "ServerForms" + (Type.namedWith [ "Form", "Handler" ] + "Handler" [ Type.string , Type.named [] "Action" ] @@ -444,7 +444,7 @@ formInit : Elm.Expression formInit = Elm.value { importFrom = [ "Form" ] - , name = "init" + , name = "form" , annotation = Nothing } |> Elm.Op.pipe @@ -465,8 +465,8 @@ initCombined : Elm.Expression -> Elm.Expression -> Elm.Expression initCombined initCombinedArg initCombinedArg0 = Elm.apply (Elm.value - { importFrom = [ "Form" ] - , name = "initCombined" + { importFrom = [ "Form", "Handler" ] + , name = "init" , annotation = Nothing } )