Update blog demo app and upgrade some Form scaffolding.

This commit is contained in:
Dillon Kearns 2023-04-19 09:47:05 -07:00
parent 538338069b
commit b550164059
8 changed files with 346 additions and 130 deletions

View File

@ -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

View File

@ -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
()
]
}

View File

@ -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",

View File

@ -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"

View File

@ -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"
},

View File

@ -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"

View File

@ -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" ]
]
)
)

View File

@ -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
}
)