git.iko.soy/gigawork-coworking/gigawork-coworking.github.io
on master help sign in
gigawork-coworking/gigawork-coworking.github.io/script/src/AddRoute.elm
312 lines 14 kB history raw
1module AddRoute exposing (run)
3import BackendTask
4import Cli.Option as Option
5import Cli.OptionsParser as OptionsParser
6import Cli.Program as Program
7import Elm
8import Elm.Annotation as Type
9import Elm.Case
10import Elm.Declare
11import Elm.Let
12import Elm.Op
13import Gen.BackendTask
14import Gen.Effect as Effect
15import Gen.FatalError
16import Gen.Form as Form
17import Gen.Form.FieldView as FieldView
18import Gen.Html as Html
19import Gen.Html.Attributes as Attr
20import Gen.Json.Encode
21import Gen.List
22import Gen.Maybe
23import Gen.Pages.Form as PagesForm
24import Gen.Pages.Script
25import Gen.Server.Request as Request
26import Gen.Server.Response as Response
27import Gen.View
28import Pages.Script as Script exposing (Script)
29import Scaffold.Form
30import Scaffold.Route exposing (Type(..))
33type alias CliOptions =
34 { moduleName : List String
35 , fields : List ( String, Scaffold.Form.Kind )
36 }
39run : Script
40run =
41 Script.withCliOptions program
42 (\cliOptions ->
43 cliOptions
44 |> createFile
45 |> Script.writeFile
46 |> BackendTask.allowFatal
47 )
50program : Program.Config CliOptions
51program =
52 Program.config
53 |> Program.add
54 (OptionsParser.build CliOptions
55 |> OptionsParser.with (Option.requiredPositionalArg "module" |> Scaffold.Route.moduleNameCliArg)
56 |> OptionsParser.withRestArgs Scaffold.Form.restArgsParser
57 )
60createFile : CliOptions -> { path : String, body : String }
61createFile { moduleName, fields } =
62 let
63 formHelpers :
64 Maybe
65 { formHandlers : Elm.Expression
66 , form : Elm.Expression
67 , declarations : List Elm.Declaration
68 }
69 formHelpers =
70 Scaffold.Form.provide
71 { fields = fields
72 , elmCssView = False
73 , view =
74 \{ formState, params } ->
75 Elm.Let.letIn
76 (\fieldView ->
77 Elm.list
78 ((params
79 |> List.map
80 (\{ name, kind, param } ->
81 fieldView (Elm.string name) param
82 )
83 )
84 ++ [ Elm.ifThen formState.submitting
85 (Html.button
86 [ Attr.disabled True
87 ]
88 [ Html.text "Submitting..."
89 ]
90 )
91 (Html.button []
92 [ Html.text "Submit"
93 ]
94 )
95 ]
96 )
97 )
98 |> Elm.Let.fn2 "fieldView"
99 ( "label", Type.string |> Just )
100 ( "field", Nothing )
101 (\label field ->
102 Html.div []
103 [ Html.label []
104 [ Html.call_.text (Elm.Op.append label (Elm.string " "))
105 , field |> FieldView.input []
106 , errorsView.call formState.errors field
107 ]
108 ]
109 )
110 |> Elm.Let.toExpression
111 }
112 in
113 Scaffold.Route.serverRender
114 { moduleName = moduleName
115 , action =
116 ( Alias
117 (Type.record
118 (case formHelpers of
119 Just _ ->
120 [ ( "errors", Type.namedWith [ "Form" ] "ServerResponse" [ Type.string ] )
121 ]
123 Nothing ->
124 []
125 )
126 )
127 , \routeParams request ->
128 formHelpers
129 |> Maybe.map
130 (\justFormHelp ->
131 Request.formData justFormHelp.formHandlers request
132 |> Gen.Maybe.call_.map
133 (Elm.fn ( "formData", Nothing )
134 (\formData ->
135 Elm.Case.tuple formData
136 "response"
137 "parsedForm"
138 (\response parsedForm ->
139 Elm.Case.custom parsedForm
140 Type.int
141 [ Elm.Case.branch1 "Form.Valid"
142 ( "validatedForm", Type.int )
143 (\validatedForm ->
144 Elm.Case.custom validatedForm
145 Type.int
146 [ Elm.Case.branch1 "Action"
147 ( "parsed", Type.int )
148 (\parsed ->
149 Scaffold.Form.recordEncoder parsed fields
150 |> Gen.Json.Encode.encode 2
151 |> Gen.Pages.Script.call_.log
152 |> Gen.BackendTask.call_.map
153 (Elm.fn ( "_", Nothing )
154 (\_ ->
155 Response.render
156 (Elm.record
157 [ ( "errors", response )
158 ]
159 )
160 )
161 )
162 )
163 ]
164 )
165 , Elm.Case.branch2 "Form.Invalid"
166 ( "parsed", Type.int )
167 ( "error", Type.int )
168 (\_ _ ->
169 "Form validations did not succeed!"
170 |> Gen.Pages.Script.log
171 |> Gen.BackendTask.call_.map
172 (Elm.fn ( "_", Nothing )
173 (\_ ->
174 Response.render
175 (Elm.record
176 [ ( "errors", response )
177 ]
178 )
179 )
180 )
181 )
182 ]
183 )
184 )
185 )
186 |> Gen.Maybe.withDefault
187 (Gen.BackendTask.fail
188 (Gen.FatalError.fromString "Expected form post")
189 )
190 )
191 |> Maybe.withDefault
192 (Gen.BackendTask.succeed
193 (Response.render
194 (Elm.record [])
195 )
196 )
197 )
198 , data =
199 ( Alias (Type.record [])
200 , \routeParams request ->
201 Gen.BackendTask.succeed
202 (Response.render
203 (Elm.record [])
204 )
205 )
206 , head = \app -> Elm.list []
207 }
208 |> Scaffold.Route.addDeclarations
209 (formHelpers
210 |> Maybe.map .declarations
211 |> Maybe.map ((::) errorsView.declaration)
212 |> Maybe.withDefault []
213 )
214 |> Scaffold.Route.buildWithLocalState
215 { view =
216 \{ shared, model, app } ->
217 Gen.View.make_.view
218 { title = moduleName |> String.join "." |> Elm.string
219 , body =
220 Elm.list
221 (case formHelpers of
222 Just justFormHelp ->
223 [ Html.h2 [] [ Html.text "Form" ]
224 , justFormHelp.form
225 |> PagesForm.call_.renderHtml
226 (Elm.list [])
227 (Form.options "form"
228 |> Form.withServerResponse
229 (app
230 |> Elm.get "action"
231 |> Gen.Maybe.map (Elm.get "errors")
232 )
233 )
234 app
235 ]
237 Nothing ->
238 [ Html.h2 [] [ Html.text "New Page" ]
239 ]
240 )
241 }
242 , update =
243 \{ shared, app, msg, model } ->
244 Elm.Case.custom msg
245 (Type.named [] "Msg")
246 [ Elm.Case.branch0 "NoOp"
247 (Elm.tuple model
248 Effect.none
249 )
250 ]
251 , init =
252 \{ shared, app } ->
253 Elm.tuple (Elm.record []) Effect.none
254 , subscriptions =
255 \{ routeParams, path, shared, model } ->
256 Elm.val "Sub.none"
257 , model =
258 Alias (Type.record [])
259 , msg =
260 Custom [ Elm.variant "NoOp" ]
261 }
264errorsView :
265 { declaration : Elm.Declaration
266 , call : Elm.Expression -> Elm.Expression -> Elm.Expression
267 , callFrom : List String -> Elm.Expression -> Elm.Expression -> Elm.Expression
268 , value : List String -> Elm.Expression
269 }
270errorsView =
271 Elm.Declare.fn2 "errorsView"
272 ( "errors", Type.namedWith [ "Form" ] "Errors" [ Type.string ] |> Just )
273 ( "field"
274 , Type.namedWith [ "Form", "Validation" ]
275 "Field"
276 [ Type.string
277 , Type.var "parsed"
278 , Type.var "kind"
279 ]
280 |> Just
281 )
282 (\errors field ->
283 Elm.ifThen
284 (Gen.List.call_.isEmpty (Form.errorsForField field errors))
285 (Html.div [] [])
286 (Html.div
287 []
288 [ Html.call_.ul (Elm.list [])
289 (Gen.List.call_.map
290 (Elm.fn ( "error", Nothing )
291 (\error ->
292 Html.li
293 [ Attr.style "color" "red"
294 ]
295 [ Html.call_.text error
296 ]
297 )
298 )
299 (Form.errorsForField field errors)
300 )
301 ]
302 )
303 |> Elm.withType
304 (Type.namedWith [ "Html" ]
305 "Html"
306 [ Type.namedWith
307 [ "PagesMsg" ]
308 "PagesMsg"
309 [ Type.named [] "Msg" ]
310 ]
311 )
312 )