Skip to content

Commit 174f6b0

Browse files
willia4willia4
committed
Updated FormField model to be a little more generic
1 parent ec7cde9 commit 174f6b0

3 files changed

Lines changed: 187 additions & 93 deletions

File tree

‎src/ElectricLemur.Muscadine.Site/FormFields.fs‎

Lines changed: 139 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -1,72 +1,166 @@
11
module FormFields
22
open ElectricLemur.Muscadine.Site
33

4-
type FormField<'m, 'a> =
5-
| RequiredField of RequiredFields.RequiredFieldDescriptor<'m, 'a>
6-
| OptionalField of OptionalFields.OptionalFieldDescriptor<'m, 'a>
7-
8-
module FormField =
9-
let fromRequiredField ff = RequiredField ff
10-
let fromOptionalField ff = OptionalField ff
11-
12-
let key (field : FormField<_, _>) =
13-
match field with
14-
| RequiredField ff -> ff.Key
15-
| OptionalField ff -> ff.Key
16-
17-
let label (field : FormField<_, _>) =
18-
match field with
19-
| RequiredField ff -> ff.Label
20-
| OptionalField ff -> ff.Label
21-
22-
let formGetter (field : FormField<_, _>) =
4+
type FieldDescriptor<'m, 'f> = {
5+
Key: string
6+
Label: string
7+
getValueFromModel: 'm -> 'f option
8+
getValueFromContext: Microsoft.AspNetCore.Http.HttpContext -> 'f option
9+
getValueFromJObject: Newtonsoft.Json.Linq.JObject -> 'f option
10+
}
11+
12+
type FormField<'m> =
13+
| RequiredStringField of FieldDescriptor<'m, string>
14+
| RequiredDateTimeField of FieldDescriptor<'m, System.DateTimeOffset>
15+
| RequiredBooleanField of FieldDescriptor<'m, bool>
16+
| RequiredImagePathsField of FieldDescriptor<'m, Image.ImagePaths>
17+
| OptionalStringField of FieldDescriptor<'m, string>
18+
| OptionalDateTimeField of FieldDescriptor<'m, System.DateTimeOffset>
19+
| OptionalBooleanField of FieldDescriptor<'m, bool>
20+
| OptionalImagePathsField of FieldDescriptor<'m, Image.ImagePaths>
21+
22+
23+
let key (field : FormField<_>) =
2324
match field with
24-
| RequiredField ff -> ff.getValueFromContext
25-
| OptionalField ff -> ff.getValueFromContext
26-
27-
let modelGetter field =
25+
| RequiredStringField ff -> ff.Key
26+
| RequiredDateTimeField ff -> ff.Key
27+
| RequiredBooleanField ff -> ff.Key
28+
| RequiredImagePathsField ff -> ff.Key
29+
| OptionalStringField ff -> ff.Key
30+
| OptionalDateTimeField ff -> ff.Key
31+
| OptionalBooleanField ff -> ff.Key
32+
| OptionalImagePathsField ff -> ff.Key
33+
34+
let label (field : FormField<_>) =
2835
match field with
29-
| RequiredField ff -> (ff.getValueFromModel >> Some)
30-
| OptionalField ff -> ff.getValueFromModel
31-
32-
let jobjGetter field =
33-
match field with
34-
| RequiredField ff -> (ff.getValueFromJObject >> Some)
35-
| OptionalField ff -> ff.getValueFromJObject
36+
| RequiredStringField ff -> ff.Label
37+
| RequiredDateTimeField ff -> ff.Label
38+
| RequiredBooleanField ff -> ff.Label
39+
| RequiredImagePathsField ff -> ff.Label
40+
| OptionalStringField ff -> ff.Label
41+
| OptionalDateTimeField ff -> ff.Label
42+
| OptionalBooleanField ff -> ff.Label
43+
| OptionalImagePathsField ff -> ff.Label
44+
45+
module ModelValue =
46+
let string field (model: 'a) =
47+
match field with
48+
| RequiredStringField ff -> ff.getValueFromModel model
49+
| OptionalStringField ff -> ff.getValueFromModel model
50+
| _ -> None
51+
52+
let dateTime field (model: 'a) =
53+
match field with
54+
| RequiredDateTimeField ff -> ff.getValueFromModel model
55+
| OptionalDateTimeField ff -> ff.getValueFromModel model
56+
| _ -> None
57+
58+
let bool field (model: 'a) =
59+
match field with
60+
| RequiredBooleanField ff -> ff.getValueFromModel model
61+
| OptionalBooleanField ff -> ff.getValueFromModel model
62+
| _ -> None
63+
64+
let imagePaths field (model: 'a) =
65+
match field with
66+
| RequiredImagePathsField ff -> ff.getValueFromModel model
67+
| OptionalImagePathsField ff -> ff.getValueFromModel model
68+
| _ -> None
69+
70+
module ContextValue =
71+
let string field ctx =
72+
match field with
73+
| RequiredStringField ff -> ff.getValueFromContext ctx
74+
| OptionalStringField ff -> ff.getValueFromContext ctx
75+
| _ -> None
76+
77+
let dateTime field ctx =
78+
match field with
79+
| RequiredDateTimeField ff -> ff.getValueFromContext ctx
80+
| OptionalDateTimeField ff -> ff.getValueFromContext ctx
81+
| _ -> None
82+
83+
module DatabaseValue =
84+
open Newtonsoft.Json.Linq
85+
86+
let string field obj =
87+
match field with
88+
| RequiredStringField ff -> ff.getValueFromJObject obj
89+
| OptionalStringField ff -> ff.getValueFromJObject obj
90+
| _ -> None
91+
92+
let dateTime field obj =
93+
match field with
94+
| RequiredDateTimeField ff -> ff.getValueFromJObject obj
95+
| OptionalDateTimeField ff -> ff.getValueFromJObject obj
96+
| _ -> None
97+
98+
let imagePaths field obj =
99+
match field with
100+
| RequiredImagePathsField ff -> ff.getValueFromJObject obj
101+
| OptionalImagePathsField ff -> ff.getValueFromJObject obj
102+
| _ -> None
36103

37104
let stringFieldUniquenessValidator ctx documentType id field =
38-
match field with
39-
| RequiredField ff -> Items.uniqueStringFieldValidator ctx documentType id ff.Key (ff.getValueFromModel >> Some)
40-
| OptionalField ff -> Items.uniqueStringFieldValidator ctx documentType id ff.Key ff.getValueFromModel
105+
Items.uniqueStringFieldValidator ctx documentType id (key field) (ModelValue.string field)
41106

42107
let setJObject model field obj =
43-
let value = (modelGetter field model)
44-
JObj.setOptionalValue (key field) value obj
108+
match field with
109+
| RequiredStringField ff -> JObj.setOptionalValue (key field) (ff.getValueFromModel model) obj
110+
| RequiredDateTimeField ff -> JObj.setOptionalValue (key field) (ff.getValueFromModel model) obj
111+
| RequiredBooleanField ff -> JObj.setOptionalValue (key field) (ff.getValueFromModel model) obj
112+
| RequiredImagePathsField ff -> JObj.setOptionalValue (key field) (ff.getValueFromModel model) obj
113+
| OptionalStringField ff -> JObj.setOptionalValue (key field) (ff.getValueFromModel model) obj
114+
| OptionalDateTimeField ff -> JObj.setOptionalValue (key field) (ff.getValueFromModel model) obj
115+
| OptionalBooleanField ff -> JObj.setOptionalValue (key field) (ff.getValueFromModel model) obj
116+
| OptionalImagePathsField ff -> JObj.setOptionalValue (key field) (ff.getValueFromModel model) obj
45117

46118
let requiredStringValidator ff =
47119
let stringGetter m =
48-
match (modelGetter ff) m with
49-
| Some v -> string v
120+
match (ModelValue.string ff) m with
121+
| Some v -> v
50122
| None -> null
51123

52124
Items.requiredStringValidator (key ff) stringGetter
53125

54126
module View =
55-
let modelValue ff m = m |> Option.bind (modelGetter ff)
56-
57-
let makeTextRow ff m =
58-
Items.makeTextInputRow (label ff) (key ff) (modelValue ff m)
127+
let modelStringValue ff m = m |> Option.bind (ModelValue.string ff)
128+
let modelBoolValue ff m = m |> Option.bind (ModelValue.bool ff)
129+
let modelImagePathsValue ff m = m |> Option.bind (ModelValue.imagePaths ff)
59130

60131
let makeTextAreaRow ff lineCount m =
61-
Items.makeTextAreaInputRow (label ff) (key ff) lineCount (modelValue ff m)
132+
Items.makeTextAreaInputRow (label ff) (key ff) lineCount (modelStringValue ff m)
133+
134+
let makeTextRow ff m =
135+
// special case some fields to make them be multi-line text areas
136+
let key = (key ff)
137+
if key = "description" then
138+
makeTextAreaRow ff 5 m
139+
else
140+
Items.makeTextInputRow (label ff) key (modelStringValue ff m)
62141

63142
let makeCheckboxRow ff m =
64-
Items.makeCheckboxInputRow (label ff) (key ff) (modelValue ff m)
143+
Items.makeCheckboxInputRow (label ff) (key ff) (modelBoolValue ff m)
65144

66-
let makeImageRow (ff: FormField<'a, Image.ImagePaths>) m =
145+
let makeImageRow ff m =
67146
let v =
68-
(modelValue ff m)
147+
(modelImagePathsValue ff m)
69148
|> Option.map (fun paths -> paths.Size512)
70149

71150
Items.makeImageInputRow (label ff) (key ff) v
72151

152+
let makeFormFieldRow ff m =
153+
match ff with
154+
| RequiredStringField _ -> makeTextRow ff m
155+
| OptionalStringField _ -> makeTextRow ff m
156+
157+
| RequiredBooleanField _ -> makeCheckboxRow ff m
158+
| OptionalBooleanField _ -> makeCheckboxRow ff m
159+
160+
| RequiredImagePathsField _ -> makeImageRow ff m
161+
| OptionalImagePathsField _ -> makeImageRow ff m
162+
163+
| RequiredDateTimeField _ -> failwith "Not Implemented"
164+
| OptionalDateTimeField _ -> failwith "Not Implemented"
165+
166+

‎src/ElectricLemur.Muscadine.Site/Game.fs‎

Lines changed: 46 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -19,51 +19,54 @@ type Game = {
1919
CoverImagePaths: Image.ImagePaths option;
2020
}
2121

22-
module Fields =
23-
let _id = FormFields.FormField.fromRequiredField ({
22+
module Fields =
23+
24+
let _id = FormFields.FormField.RequiredStringField ({
2425
Key = "_id"
2526
Label = "Id"
26-
getValueFromModel = (fun g -> g.Id)
27+
getValueFromModel = (fun g -> Some g.Id)
2728
getValueFromContext = (fun ctx -> None)
28-
getValueFromJObject = (fun obj -> JObj.getter<string> obj "_id" |> Option.get) })
29+
getValueFromJObject = (fun obj -> JObj.getter<string> obj "_id") })
2930

30-
let _dateAdded = FormFields.FormField.fromRequiredField ({
31+
let _dateAdded = FormFields.FormField.RequiredDateTimeField({
3132
Key = "_dateAdded"
3233
Label = "Date Added"
33-
getValueFromModel = (fun g -> g.DateAdded)
34+
getValueFromModel = (fun g -> Some g.DateAdded)
3435
getValueFromContext = (fun ctx -> None)
35-
getValueFromJObject = (fun obj -> JObj.getter<System.DateTimeOffset> obj "_dateAdded" |> Option.get) })
36+
getValueFromJObject = (fun obj -> JObj.getter<System.DateTimeOffset> obj "_dateAdded") })
3637

37-
let name = FormFields.FormField.fromRequiredField ({
38+
let name = FormFields.FormField.RequiredStringField ({
3839
Key = "name"
3940
Label = "Name"
40-
getValueFromModel = (fun g -> g.Name)
41+
getValueFromModel = (fun g -> Some g.Name)
4142
getValueFromContext = (fun ctx -> HttpFormFields.fromContext ctx |> HttpFormFields.stringOptionValue "name")
42-
getValueFromJObject = (fun obj -> JObj.getter<string> obj "name" |> Option.get) })
43+
getValueFromJObject = (fun obj -> JObj.getter<string> obj "name") })
4344

44-
let description = FormFields.FormField.fromRequiredField ({
45+
let description = FormFields.FormField.RequiredStringField ({
4546
Key = "description"
4647
Label = "Description"
47-
getValueFromModel = (fun g -> g.Description)
48+
getValueFromModel = (fun g -> Some g.Description)
4849
getValueFromContext = (fun ctx -> HttpFormFields.fromContext ctx |> HttpFormFields.stringOptionValue "description")
49-
getValueFromJObject = (fun obj -> JObj.getter<string> obj "description" |> Option.get) })
50+
getValueFromJObject = (fun obj -> JObj.getter<string> obj "description") })
5051

51-
let slug = FormFields.FormField.fromRequiredField ({
52+
let slug = FormFields.FormField.RequiredStringField ({
5253
Key = "slug"
5354
Label = "Slug"
54-
getValueFromModel = (fun g -> g.Slug)
55+
getValueFromModel = (fun g -> Some g.Slug)
5556
getValueFromContext = (fun ctx -> HttpFormFields.fromContext ctx |> HttpFormFields.stringOptionValue "slug")
56-
getValueFromJObject = (fun obj -> JObj.getter<string> obj "slug" |> Option.get) })
57+
getValueFromJObject = (fun obj -> JObj.getter<string> obj "slug") })
5758

58-
let coverImagePaths = FormFields.FormField.fromOptionalField ({
59+
let coverImagePaths = FormFields.FormField.OptionalImagePathsField ({
5960
Key = "coverImage"
6061
Label = "Cover Image"
6162
getValueFromModel = (fun g -> g.CoverImagePaths)
6263
getValueFromContext = (fun _ -> raise (new NotImplementedException("Cannot get coverImage from form fields")))
63-
getValueFromJObject = (fun obj -> JObj.getter<Image.ImagePaths> obj "coverImage"
64-
)})
64+
getValueFromJObject = (fun obj -> JObj.getter<Image.ImagePaths> obj "coverImage" )})
6565

66-
let addEditView (g: Game option) allTags documentTags =
66+
let viewFields = [
67+
name; description; slug; coverImagePaths
68+
]
69+
let addEditView (g: Game option) fields allTags documentTags =
6770

6871
let pageTitle = match g with
6972
| None -> "Add Game"
@@ -74,17 +77,16 @@ let addEditView (g: Game option) allTags documentTags =
7477
| Some g -> Map.ofList [ ("id", Items.pageDataType.String g.Id); ("slug", Items.pageDataType.String "game")]
7578
| None -> Map.empty
7679

80+
7781
Items.layout pageTitle pageData [
7882
div [ _class "page-title" ] [ encodedText pageTitle ]
7983
form [ _name "game-form"; _method "post"; _enctype "multipart/form-data" ] [
8084
table [] [
81-
FormFields.View.makeTextRow Fields.name g
82-
FormFields.View.makeTextAreaRow Fields.description 5 g
83-
FormFields.View.makeTextRow Fields.slug g
84-
FormFields.View.makeImageRow Fields.coverImagePaths g
85+
for ff in fields do
86+
yield FormFields.View.makeFormFieldRow ff g
8587

86-
Items.makeTagsInputRow "Tags" Tag.formKey allTags documentTags
87-
tr [] [
88+
yield Items.makeTagsInputRow "Tags" Tag.formKey allTags documentTags
89+
yield tr [] [
8890
td [] []
8991
td [] [ input [ _type "submit"; _value "Save" ] ]
9092
]
@@ -119,36 +121,37 @@ let makeAndValidateModelFromContext (existing: Game option) (ctx: HttpContext):
119121
|> HttpFormFields.checkRequiredStringField fields (FormFields.key Fields.name)
120122
|> HttpFormFields.checkRequiredStringField fields (FormFields.key Fields.description)
121123
|> HttpFormFields.checkRequiredStringField fields (FormFields.key Fields.slug)
122-
123-
let o = ctx |> (FormFields.formGetter Fields.name) |> Option.get
124+
124125
match requiredFieldsAreValid with
125-
| Ok _ ->
126-
let getValue f = (f |> FormFields.formGetter) ctx |> Option.get
127-
let getNonFormFieldValue f = existing |> Option.bind (fun g -> (f |> FormFields.modelGetter) g)
126+
| Ok _ ->
127+
let getFormStringValue f = FormFields.ContextValue.string f ctx |> Option.get
128+
let getModelImagePathsValue f =
129+
existing |> Option.bind (fun g -> FormFields.ModelValue.imagePaths f g)
128130

129131
let g = {
130132
Id = id
131133
DateAdded = dateAdded
132-
Name = Fields.name |> getValue
133-
Description = Fields.description |> getValue
134-
Slug = Fields.slug |> getValue
135-
CoverImagePaths = Fields.coverImagePaths |> getNonFormFieldValue
134+
Name = Fields.name |> getFormStringValue
135+
Description = Fields.description |> getFormStringValue
136+
Slug = Fields.slug |> getFormStringValue
137+
CoverImagePaths = Fields.coverImagePaths |> getModelImagePathsValue
136138
}
137139
validateModel id g ctx
138140
| Error msg -> Task.fromResult (Error msg)
139141

140142

141143
let makeModelFromJObject (obj: JObject) =
142-
let getValue f = (f |> FormFields.jobjGetter) obj |> Option.get
143-
let getOptionalValue f = (f |> FormFields.jobjGetter) obj
144+
let stringValue f = FormFields.DatabaseValue.string f obj |> Option.get
145+
let dateValue f = FormFields.DatabaseValue.dateTime f obj |> Option.get
146+
let getImagePathsValue f = FormFields.DatabaseValue.imagePaths f obj
144147

145148
{
146-
Id = Fields._id |> getValue
147-
DateAdded = Fields._dateAdded |> getValue
148-
Name = Fields.name |> getValue
149-
Description = Fields.description |> getValue
150-
Slug = Fields.slug |> getValue
151-
CoverImagePaths = Fields.coverImagePaths |> getOptionalValue
149+
Id = Fields._id |> stringValue
150+
DateAdded = Fields._dateAdded |> dateValue
151+
Name = Fields.name |> stringValue
152+
Description = Fields.description |> stringValue
153+
Slug = Fields.slug |> stringValue
154+
CoverImagePaths = Fields.coverImagePaths |> getImagePathsValue
152155
}
153156

154157
let tryMakeModelFromJObject (obj: JObject) =

‎src/ElectricLemur.Muscadine.Site/ItemHelper.fs‎

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -285,21 +285,18 @@ module Views =
285285
]
286286
]
287287
]
288-
// |> List.prepend [
289-
290-
// ]
291288

292289
module Admin =
293290
let addView itemDocumentType allTags =
294291
match ItemDocumentType.fromString itemDocumentType with
295-
| Some GameDocumentType -> Game.addEditView None allTags []
292+
| Some GameDocumentType -> Game.addEditView None Game.Fields.viewFields allTags []
296293
| Some ProjectDocumentType -> Project.addEditView None allTags []
297294
| Some BookDocumentType -> Book.addEditView None allTags []
298295
| None -> failwith $"Could not determine addView for document type {itemDocumentType}"
299296

300297
let editView item =
301298
match item with
302-
| Game g -> Game.addEditView (Some g)
299+
| Game g -> Game.addEditView (Some g) Game.Fields.viewFields
303300
| Project p -> Project.addEditView (Some p)
304301
| Book b -> Book.addEditView (Some b)
305302

0 commit comments

Comments
 (0)