(* file: form.ml *)
open Fmlib_browser
(* Fabric *)
let epx200 = [
"Army Olive EPX200"
; "Black Knight EPX200"
; "Brick Red EPX200"
; "Bright Blue EPX200"
; "Bright Orange EPX200"
; "Coyote Brown EPX200"
; "Deep Purple EPX200"
; "Fuchsia EPX200"
; "Golden Dazy EPX200"
; "Green Mountain EPX200"
; "Ocean Blue EPX200"
; "Red Barn EPX200"
; "Snow White EPX200"
; "Teal EPX200"
; "Wolf Grey EPX200"
]
let epx400 = [
"Black Knight EPX400"
]
let ultra = [
"Black Ultra 400TX"
]
let vx42 = [
"Black VX42"
]
let vx21 = [
"Black VX21 Cire"
]
let vx07 = [
"Navy Blue VX07"
; "Red VX07"
; "Off-white VX07"
]
let liteskin = [
"Liteskin LS07"
]
(* Pack Specifications *)
let i_am_going_for_list = [
"a balance of durability and light weight"
; "durability"
; "light weight"
]
let pack_list = [
""
; "70l Alpine Pack"
; "65l Classic Pack"
; "60l Alpine Pack"
; "55l Classic Pack"
; "50l Alpine Pack"
; "45l Classic Pack"
; "35l Fast Pack"
; "25l Strong Pack"
; "25l Fast Pack"
]
let spec_ = [
""
]
let specCP65 = [
"Slightly narrower at hip level, tapered rolltop"
; "Average width: 34cm"
; "Depth: 22cm"
; "Height: 87cm"
; "Volume: 65l to the top of an open bag, excluding pockets and any for Ultra 400TX rolltop"
; "Weight: 1 to 1.2 kilograms depending on fabric selection and torso length"
; "Carry quite a considerable load (but not 40kg of meat)"
; "2 Side Compression Straps (each side)"
; "Large side pockets with bungy cord closure"
; "Large HDPE Gridstop back pocket with 3mm bungy cord"
; "1 Ice Axe Loop"
; "Loops to carry hiking poles"
; "Flat Lycra Hip Belt Pockets"
; "Internal pocket that can double as a shoulder bag"
; "Removable aluminium frame"
; "Replaceable EVA foam back padding"
; "Load lifters"
; "Y strap (over the top)"
; "Tapered rolltop with 19mm side release buckle"
; "Sternum Strap"
; "Replaceable Pack Base"
]
let specCP55 = [
"Slightly narrower at hip level, tapered rolltop"
; "Average width: 31cm"
; "Depth: 21cm"
; "Height: 85cm"
; "Volume: 55l to the top of an open bag, excluding pockets and any for Ultra 400TX rolltop"
; "Weight: 1 to 1.2 kilograms depending on fabric selection and torso length"
; "Carry quite a considerable load (but not 40kg of meat)"
; "2 Side Compression Straps (each side)"
; "Large side pockets with bungy cord closure"
; "Large HDPE Gridstop back pocket with 3mm bungy cord"
; "1 Ice Axe Loop"
; "Loops to carry hiking poles"
; "Flat Lycra Hip Belt Pockets"
; "Internal pocket that can double as a shoulder bag"
; "Removable aluminium frame"
; "Replaceable EVA foam back padding"
; "Load lifters"
; "Y strap (over the top)"
; "Tapered rolltop with 19mm side release buckle"
; "Sternum Strap"
; "Replaceable Pack Base"
]
let specFP45 = [
"Slightly narrower at hip level"
; "Average width: 28cm"
; "Depth: 19cm"
; "Height: 87cm"
; "Volume: 46l to the top of an open bag, excluding pockets and any for Ultra 400TX rolltop"
; "Weight: 0.65 to 1 kilograms depending on fabric selection and torso length"
; "Carry a reasonable load"
; "Bungy cord side compression"
; "Large side pockets with bungy cord closure"
; "Large HDPE Gridstop back pocket with bungy cord"
; "1 Ice Axe Loop"
; "Loops to carry hiking poles"
; "Flat Lycra Hip Belt Pockets"
; "Internal pocket that can double as a shoulder bag"
; "Integrated back padding (EVA foam, minimal)"
; "Load lifters"
; "Y strap (over the top)"
; "Tapered rolltop with 19mm side release buckle"
; "Sternum Strap"
]
let specFP35 = [
"Slightly narrower at hip level"
; "Average width: 27cm"
; "Depth: 18cm"
; "Height: 75cm"
; "Volume: 36l to the top of an open bag, excluding pockets and any for Ultra 400TX rolltop"
; "Weight: 350 to 850 grams depending on fabric selection and torso length"
; "Carry a reasonable load"
; "Bungy cord side compression"
; "Large side pockets with bungy cord closure"
; "Lycra back pocket with bungy cord"
; "Lycra pocket on the pack base"
; "Loops to carry hiking poles"
; "Removable 25mm webbing waist belt"
; "Sternum Strap"
]
let specSP25 = [
"Average width: 27cm"
; "Depth: 17cm"
; "Height: 60cm"
; "Volume: 27l to the top of an open bag, excluding pockets"
; "Weight: ~450 grams depending on fabric selection"
; "Carry a reasonable load"
; "Lycra side pockets"
; "Lycra back pocket with bungy cord"
; "Removable 25mm webbing waist belt"
; "Sternum Strap"
]
let specFP25 = [
"Average width: 25cm"
; "Depth: 18cm"
; "Height: 57cm"
; "Volume: 25l to the top of an open bag"
; "Weight: ~300 grams"
; "Carry a reasonable load"
; "Lycra pocket on the pack base"
; "Removable 25mm webbing waist belt"
; "Sternum Strap"
]
let specAC70 = [
"Pear shaped (wider at hip level)"
; "Average circumference: 100.5cm"
; "Height: 87cm"
; "Volume: 70l to the top of an open bag"
; "Weight: 1 to 1.2 kilograms depending on fabric selection and torso length"
; "Carry quite a considerable load (but not 40kg of meat)"
; "Brilliant for alpine use, bush bashing, packrafting, carrying tripods, skis etc."
; "6 compression straps (removable)"
; "Small side pockets for snow stakes or paddles"
; "Ice axe toggles"
; "Gear Loops (on waist belt)"
; "Internal pocket that can double as a shoulder bag"
; "Removable aluminium frame"
; "Replaceable EVA foam back padding"
; "Load lifters"
; "Y strap (over the top)"
; "Tapered rolltop with 19mm side release buckle"
; "Sternum Strap"
]
let specAC60 = [
"Pear shaped (wider at hip level)"
; "Average circumference: 98.5cm"
; "Height: 80cm"
; "Volume: 60l to the top of an open bag"
; "Weight: 1 to 1.2 kilograms depending on fabric selection and torso length"
; "Carry quite a considerable load (but not 40kg of meat)"
; "Brilliant for alpine use, bush bashing, packrafting, carrying tripods, skis etc."
; "6 compression straps (removable)"
; "Small side pockets for snow stakes or paddles"
; "Ice axe toggles"
; "Gear Loops (on waist belt)"
; "Internal pocket that can double as a shoulder bag"
; "Removable aluminium frame"
; "Replaceable EVA foam back padding"
; "Load lifters"
; "Y strap (over the top)"
; "Tapered rolltop with 19mm side release buckle"
; "Sternum Strap"
]
let specAC50 = [
"Slightly narrower at hip level"
; "Average circumference: 92cm"
; "Height: 80cm"
; "Volume: 50l to the top of an open bag"
; "Weight: 1+ kilograms depending on fabric selection and torso length"
; "Carry quite a considerable load (but not 40kg of meat)"
; "Brilliant for alpine use, bush bashing, packrafting, carrying tripods, skis etc."
; "6 compression straps (removable)"
; "Small side pockets for snow stakes or paddles"
; "Ice axe toggles"
; "Gear Loops (on waist belt)"
; "Internal pocket that can double as a shoulder bag"
; "Removable aluminium frame"
; "Replaceable EVA foam back padding"
; "Load lifters"
; "Y strap (over the top)"
; "Tapered rolltop with 19mm side release buckle"
; "Sternum Strap"
]
(* Pack Prices *)
let bottle_pocket_price = 25
let lid_price = 120
let waist_bag_price = 75
let shoulder_bag_price = 65
let pack_match str =
match str with
| "" -> (0, spec_)
| "65l Classic Pack" -> (630, specCP65)
| "55l Classic Pack" -> (600, specCP55)
| "45l Classic Pack" -> (430, specFP45)
| "35l Fast Pack" -> (390, specFP45)
| "25l Strong Pack" -> (275, specSP25)
| "25l Fast Pack" -> (275, specFP25)
| "70l Alpine Pack" -> (550, specAC70)
| "60l Alpine Pack" -> (500, specAC60)
| "50l Alpine Pack" -> (460, specAC50)
| _ -> (0, spec_)
let ultra_price str =
match str with
| "" -> 0
| "65l Classic Pack" -> 120
| "55l Classic Pack" -> 110
| "45l Classic Pack" -> 100
| "35l Fast Pack" -> 90
| "25l Strong Pack" -> 0
| "25l Fast Pack" -> 0
| "70l Alpine Pack" -> 120
| "60l Alpine Pack" -> 110
| "50l Alpine Pack" -> 100
| _ -> 0
let lucky = ["I'm feeling lucky!"]
let panel_match str =
match str with
| "" ->
(lucky, lucky, lucky)
| "65l Classic Pack" ->
(vx21, (List.concat [lucky; epx200; epx400]), ultra)
| "55l Classic Pack" ->
(vx21, (List.concat [lucky; epx200; epx400]), ultra)
| "45l Classic Pack" ->
((List.concat [lucky; vx07; vx21]), (List.concat [lucky; epx200]), ultra)
| "35l Fast Pack" ->
((List.concat [lucky; vx07; vx21]), (List.concat [lucky; epx200]), ultra)
| "25l Strong Pack" ->
((List.concat [lucky; epx200]), (List.concat [lucky; epx200]), (List.concat [lucky; epx200]))
| "25l Fast Pack" ->
(liteskin, liteskin, liteskin)
| "70l Alpine Pack" ->
(vx21, epx400, ultra)
| "60l Alpine Pack" ->
(vx21, epx400, ultra)
| "50l Alpine Pack" ->
(vx21, vx21, ultra)
| _ ->
(lucky, lucky, lucky)
let pocket_match str =
match str with
| "" ->
(lucky, lucky, lucky)
| "65l Classic Pack" ->
((List.concat [lucky; vx07]), (List.concat [lucky; epx200]), (List.concat [lucky; vx07; epx200]))
| "55l Classic Pack" ->
((List.concat [lucky; vx07]), (List.concat [lucky; epx200]), (List.concat [lucky; vx07; epx200]))
| "45l Classic Pack" ->
((List.concat [lucky; liteskin; vx07]), (List.concat [lucky; epx200]), (List.concat [lucky; vx07; epx200]))
| "35l Fast Pack" ->
((List.concat [lucky; liteskin; vx07]), (List.concat [lucky; epx200]), (List.concat [lucky; vx07; epx200]))
| "25l Strong Pack" ->
(["Lycra"; "None"], ["Lycra"; "None"], ["Lycra"; "None"])
| "25l Fast Pack" ->
(["None"], ["None"], ["None"])
| "70l Alpine Pack" ->
((List.concat [lucky; vx21; vx42]), (List.concat [lucky; epx400; epx200]), ["Ultra"])
| "60l Alpine Pack" ->
((List.concat [lucky; vx21; vx42]), (List.concat [lucky; epx400; epx200]), ["Ultra"])
| "50l Alpine Pack" ->
((List.concat [lucky; vx21; vx42]), (List.concat [lucky; vx21; vx42]), ["Ultra"])
| _ ->
(lucky, lucky, lucky)
let rolltop_match str =
match str with
| "" ->
(lucky, lucky, lucky)
| "65l Classic Pack" ->
((List.concat [lucky; vx07]), (List.concat [lucky; epx200]), (List.concat [lucky; vx07; epx200]))
| "55l Classic Pack" ->
((List.concat [lucky; vx07]), (List.concat [lucky; epx200]), (List.concat [lucky; vx07; epx200]))
| "45l Classic Pack" ->
((List.concat [lucky; liteskin; vx07]), (List.concat [lucky; epx200]), (List.concat [lucky; vx07; epx200]))
| "35l Fast Pack" ->
((List.concat [lucky; liteskin; vx07]), (List.concat [lucky; epx200]), (List.concat [lucky; vx07; epx200]))
| "25l Strong Pack" ->
([""], [""], [""])
| "25l Fast Pack" ->
([""], [""], [""])
| "70l Alpine Pack" ->
((List.concat [lucky; vx07; epx200]), (List.concat [lucky; vx07; epx200]), (List.concat [lucky; vx07; epx200]))
| "60l Alpine Pack" ->
((List.concat [lucky; vx07; epx200]), (List.concat [lucky; vx07; epx200]), (List.concat [lucky; vx07; epx200]))
| "50l Alpine Pack" ->
((List.concat [lucky; vx07; epx200]), (List.concat [lucky; vx07; epx200]), (List.concat [lucky; vx07; epx200]))
| _ ->
(lucky, lucky, lucky)
let pack_price t =
match (pack_match t) with (x, _) -> x
let pack_spec t =
match (pack_match t) with (_, y) -> y
(* note order matters here *)
let goal (l, b, d) t =
match t with
| "light weight" -> l
| "a balance of durability and light weight" -> b
| "durability" -> d
| _ -> b
let pack_panels p g =
goal (panel_match p) g
let pack_pockets p g =
goal (pocket_match p) g
let pack_rolltop p g =
goal (rolltop_match p) g
let first_element list =
match list with
| [] -> ""
| hd::tail -> hd
(* Model*)
type state = {
i_am_going_for : string
; select_a_pack : string
; side_panels : string
; side_pockets : string
; back_panel : string
; rolltop : string
; torso : string
; waist : string
; bottle_pocket_quantity : string
; bottle_pocket_colour : string
; lid : string
; waist_bag : string
; shoulder_bag : string
; email : string
; first_name : string
; last_name : string
; postal_address : string
; message : string
}
let init : state =
{
i_am_going_for = first_element i_am_going_for_list
; select_a_pack = first_element pack_list
; side_panels = first_element lucky
; side_pockets = first_element lucky
; back_panel = first_element lucky
; rolltop = first_element lucky
; torso = ""
; waist = ""
; bottle_pocket_quantity = "0"
; bottle_pocket_colour = first_element lucky
; lid = "No, always in the way!"
; waist_bag = "No"
; shoulder_bag = "No"
; email = ""
; first_name = ""
; last_name = ""
; postal_address = ""
; message = ""
}
(* Messages *)
type msg =
| I_am_going_for of string
| Select_a_pack of string
| Side_panels of string
| Side_pockets of string
| Back_panel of string
| Rolltop of string
| Torso of string
| Waist of string
| Bottle_pocket_quantity of string
| Bottle_pocket_colour of string
| Lid of string
| Waist_bag of string
| Shoulder_bag of string
| First_name of string
| Last_name of string
| Email of string
| Postal_address of string
| Message of string
(* Views*)
let empty_view state =
let open Html in
let open Attribute in
div [id "empty_view"] []
let ultra_view state =
let open Html in
let open Attribute in
p [] [
text "Plus NZD "
; text (state.select_a_pack |> ultra_price |> string_of_int)
; text " for Ultra 400TX"
]
let get_ultra_view str =
match str with
| "a balance of durability and light weight" -> empty_view
| "durability" -> ultra_view
| "light weight" -> empty_view
| _ -> empty_view
let pack_view state =
let open Html in
let open Attribute in
let details attrs nodes = node "details" attrs nodes in
let summary attrs nodes = node "summary" attrs nodes in
let a attrs nodes = node "a" attrs nodes in
div [] [
p [] [text "Base Price NZD: "; text (state.select_a_pack |> pack_price |> string_of_int)]
; div [id "conditional"] [get_ultra_view state.i_am_going_for state]
; details [] [
summary [] [a [] [text "Specification"]]
; ul [] (List.map (fun x -> li [] [text x]) (state.select_a_pack |> pack_spec))
]
]
let accessory_view state =
let open Html in
let open Attribute in
let bottle_pocket_quantity str = Bottle_pocket_quantity str in
let bottle_pocket_colour str = Bottle_pocket_colour str in
let lid str = Lid str in
let waist_bag str = Waist_bag str in
let shoulder_bag str = Shoulder_bag str in
let details attrs nodes = node "details" attrs nodes in
let summary attrs nodes = node "summary" attrs nodes in
let a attrs nodes = node "a" attrs nodes in
let article attrs nodes = node "article" attrs nodes in
details [] [
summary [] [ a [] [text "Accessories"] ]
; article [] [
div [class_ "grid"] [
label [attribute "for" "bottle_pocket_quantity"] [text "Strap Bottle Pockets"
; select [
attribute "type" "text"
;attribute "name" "bottle_pocket_quantity"
;id "bottle_pocket_quantity"
; value state.bottle_pocket_quantity
; on_input bottle_pocket_quantity
]
(List.map (fun x -> node "option" [] [text x]) [""; "1"; "2"; "3"; "4"])
]
; label [attribute "for" "bottle_pocket_colour"] [text "Colour"
;select [
attribute "type" "text"
; attribute "name" "bottle_pocket_colour"
; id "bottle_pocket_colour"
; value state.bottle_pocket_colour
; on_input bottle_pocket_colour
]
(List.map (fun x -> node "option" [] [text x]) (List.concat [lucky; vx07; epx200]))
]
]
; p [] [text "Price NZD: " ; text (string_of_int bottle_pocket_price); text " each"]
]
; article [] [
label [attribute "for" "lid"] [text "Backpack Lid"
;select [
attribute "type" "text"
; attribute "name" "lid"
; id "lid"
; value state.lid
; on_input lid
]
(List.map (fun x -> node "option" [] [text x]) ["No, always in the way!"; "Yes please, add a lid."])
]
; p [] [text "Price NZD: " ; text (string_of_int lid_price)]
; p [] [text "The lid fits all Fiordland Packs with a Y stap, it will not fit a 25l or 35l pack."]
]
; article [] [
label [attribute "for" "waist_bag"] [text "Waist Bag"
;select [
attribute "type" "text"
; attribute "name" "waist_bag"
; id "waist_bag"
; value state.waist_bag
; on_input waist_bag
]
(List.map (fun x -> node "option" [] [text x]) (List.append [""; "Navy Blue VX07"; "Red VX07"; "Off-white; VX07"] epx200))
]
; p [] [text "Price NZD: " ; text (string_of_int waist_bag_price)]
]
; article [] [
label [attribute "for" "shoulder_bag"] [text "Shoulder Bag"
;select [
attribute "type" "text"
; attribute "name" "shoulder_bag"
; id "shoulder_bag"
; value state.shoulder_bag
; on_input shoulder_bag
]
(List.map (fun x -> node "option" [] [text x]) (List.append [""; "Navy Blue VX07"; "Red VX07"; "Off-white VX07"] epx200))
]
; p [] [text "Price NZD: " ; text (string_of_int shoulder_bag_price)]
]
]
let get_pack_view str =
match str with
| "" -> empty_view
| "65l Classic Pack" -> pack_view
| "55l Classic Pack" -> pack_view
| "45l Classic Pack" -> pack_view
| "35l Fast Pack" -> pack_view
| "25l Strong Pack" -> pack_view
| "25l Fast Pack" -> pack_view
| "70l Alpine Pack" -> pack_view
| "60l Alpine Pack" -> pack_view
| "50l Alpine Pack" -> pack_view
| _ -> empty_view
let header_view state =
let open Html in
let open Attribute in
let img attrs nodes = node "img" attrs nodes in
div [] [
div [class_ "grid"] [
div [] []
; img [src "logo.svg"] []
; div [] []
]
; p [] [text "Please complete this order form. I'll send an invoice tomorrow morning. Payment is by direct
deposit or Stripe. Wait time is currently 2-3 weeks."]
]
let contact_view state =
let open Html in
let open Attribute in
let details attrs nodes = node "details" attrs nodes in
let summary attrs nodes = node "summary" attrs nodes in
let a attrs nodes = node "a" attrs nodes in
details [] [
summary [] [a [] [text "Contact Fiordland Packs"]]
; ul [] [
li [] [a [href "https://fiordlandpacks.nz"] [text "fiordlandpacks.nz"]]
; li [] [a [href "mailto:david@fiordlandpacks.nz"] [text "Email"]]
; li [] [a [href "tel:+0277561938"] [text "Phone"]]
; li [] [
details [] [
summary [] [a [] [text "Visit"]]
; p [] [ text "38 Caswell Road, Te Anau, Te Anau 9600" ]
]
]
]
]
let measurement_view state =
let open Html in
let open Attribute in
let torso str = Torso str in
let waist str = Waist str in
let details attrs nodes = node "details" attrs nodes in
let summary attrs nodes = node "summary" attrs nodes in
let a attrs nodes = node "a" attrs nodes in
div [] [
div [] [
details [] [
summary [] [a [] [text "How to measure your torso"]]
; p [] [text "Find your C7 vertebra by bowing your head forward and finding the big bump sticking out on your spine at the bottom of your neck or around shoulder height."]
; p [] [text "Find the top of your sacrum by placing your fore fingers on your hip bones (the Posterior Superior Iliac Spine), thumbs pointing in and resting in the small of your back."]
; p [] [text "Use a tape measure or piece of string to measure the length of your spine inbetween, conforming to the curves of your back."]
]
]
;label [attribute "for" "torso"] [text "Torso Length"; input [
attribute "type" "text"
; attribute "name" "torso"
; id "torso"
; value state.torso
; on_input torso
] []]
; label [attribute "for" "waist"] [text "Waist Circumference"; input [
attribute "type" "text"
; attribute "name" "waist"
; id "waist"
; value state.waist
; on_input waist
] []]
]
let get_measurement_view str =
match str with
| "" -> empty_view
| "65l Classic Pack" -> measurement_view
| "55l Classic Pack" -> measurement_view
| "45l Classic Pack" -> measurement_view
| "35l Fast Pack" -> measurement_view
| "25l Strong Pack" -> empty_view
| "25l Fast Pack" -> empty_view
| "70l Alpine Pack" -> measurement_view
| "60l Alpine Pack" -> measurement_view
| "50l Alpine Pack" -> measurement_view
| _ -> empty_view
let rolltop_view state =
let open Html in
let open Attribute in
let rolltop str = Rolltop str in
div [] [
label [attribute "for" "rolltop"] [
text "Rolltop"
; select [
attribute "type" "text"
; attribute "name" "rolltop"
; id "rolltop"
; value state.rolltop
; on_input rolltop
]
(List.map (fun x -> node "option" [] [text x]) (pack_rolltop state.select_a_pack state.i_am_going_for))
]
]
let get_rolltop_view str =
match str with
| "" -> rolltop_view
| "65l Classic Pack" -> rolltop_view
| "55l Classic Pack" -> rolltop_view
| "45l Classic Pack" -> rolltop_view
| "35l Fast Pack" -> rolltop_view
| "25l Strong Pack" -> empty_view
| "25l Fast Pack" -> empty_view
| "70l Alpine Pack" -> rolltop_view
| "60l Alpine Pack" -> rolltop_view
| "50l Alpine Pack" -> rolltop_view
| _ -> rolltop_view
let see_view state =
let open Html in
let open Attribute in
div [] [
li [] [ text "i am going for: "; text state.i_am_going_for ]
; li [] [ text "select a pack: "; text state.select_a_pack ]
; li [] [ text "side panels: "; text state.side_panels ]
; li [] [ text "side pockets: "; text state.side_pockets ]
; li [] [ text "back panel: "; text state.back_panel ]
; li [] [ text "rolltop: "; text state.rolltop ]
; li [] [ text "torso: "; text state.torso ]
; li [] [ text "waist: "; text state.waist ]
; li [] [ text "bottle pocket quantity: "; text state.bottle_pocket_quantity ]
; li [] [ text "bottle pocket colour: "; text state.bottle_pocket_colour ]
; li [] [ text "lid: "; text state.lid ]
; li [] [ text "waist bag: "; text state.waist_bag ]
; li [] [ text "shoulder bag: "; text state.shoulder_bag ]
; li [] [ text "first name: "; text state.first_name ]
; li [] [ text "last name: "; text state.last_name ]
; li [] [ text "email: "; text state.email ]
; li [] [ text "postal address: "; text state.postal_address ]
; li [] [ text "message: "; text state.message ]
]
let view state =
let open Html in
let open Attribute in
let i_am_going_for str = I_am_going_for str in
let select_a_pack str = Select_a_pack str in
let side_panels str = Side_panels str in
let side_pockets str = Side_pockets str in
let back_panel str = Back_panel str in
let first_name str = First_name str in
let last_name str = Last_name str in
let email str = Email str in
let postal_address str = Postal_address str in
let message str = Message str in
let section attrs nodes = node "section" attrs nodes in
let form attrs nodes = node "form" attrs nodes in
let mark attrs nodes = node "mark" attrs nodes in
div [class_ "container"] [
section [id "header"] [ header_view state ]
; section [id "main"] [
form [attribute "action" "https://formspree.io/f/mjvnykql"; attribute "method" "post"] [
section [id "backpacks"] [
label [attribute "for" "select_a_pack"] [
mark [] [text "Select a backpack"]
; select [
attribute "type" "text"
; attribute "name" "select_a_pack"
; id "select_a_pack"
; value state.select_a_pack
; on_input select_a_pack
]
(List.map (fun x -> node "option" [] [text x]) pack_list)
]
; label [attribute "for" "i_am_going_for"] [text "I'm going for"; select [
attribute "type" "text"
; attribute "name" "i_am_going_for"
; id "i_am_going_for"
; value state.i_am_going_for
; on_input i_am_going_for
]
(List.map (fun x -> node "option" [] [text x]) i_am_going_for_list)
]
; section [id "conditional"] [get_pack_view state.select_a_pack state]
; section [id "fabric_and_colour"] [
label [attribute "for" "side_panels"] [
text "Side Panels"
; select [
attribute "type" "text"
; attribute "name" "side_panels"
; id "side_panels"
; value state.side_panels
; on_input side_panels
]
(List.map (fun x -> node "option" [] [text x]) (pack_panels state.select_a_pack state.i_am_going_for))
]
; label [attribute "for" "side_pockets"] [
text "Side Pockets"
; select [
attribute "type" "text"
; attribute "name" "side_pockets"
; id "side_pockets"
; value state.side_pockets
; on_input side_pockets
]
(List.map (fun x -> node "option" [] [text x]) (pack_pockets state.select_a_pack state.i_am_going_for))
]
; label [attribute "for" "back_panel"] [
text "Back Panel"
; select [
attribute "type" "text"
; attribute "name" "back_panel"
; id "back_panel"
; value state.back_panel
; on_input back_panel
]
(List.map (fun x -> node "option" [] [text x]) (pack_panels state.select_a_pack state.i_am_going_for))
]
; get_rolltop_view state.select_a_pack state
]
]
; section [id "measurements"] [
get_measurement_view state.select_a_pack state
]
; section [id "accessories"] [ accessory_view state ]
; section [id "personal_details"] [
label [attribute "for" "email"] [text "Email"; input [
attribute "type" "email"
; attribute "name" "_replyto"
; id "email"
; value state.email
; on_input email
] []]
; div [class_ "grid"] [
label [attribute "for" "first_name"] [text "First Name"; input [
attribute "type" "text"
; attribute "name" "first_name"
; id "first_name"
; value state.first_name
; on_input first_name
] []]
; label [attribute "for" "last_name"] [text "Last Name"; input [
attribute "type" "text"
; attribute "name" "last_name"
; id "last_name"
; value state.last_name
; on_input last_name
] []]
]
; label [attribute "for" "postal_address"] [text "Postal Address"; textarea [
attribute "type" "text"
; attribute "name" "postal_address"
; id "postal_address"
; value state.postal_address
; on_input postal_address
] []]
; p [] [text "Shipping is by NZ Post Courier. Cost is usually NZD 15-35. Australia ~NZD 35. Europe ~NZD 85."]
]
; section [id "tail"] [
label [attribute "for" "message"] [text "Message"; textarea [
attribute "type" "text"
; attribute "name" "message"
; id "message"
; value state.message
; on_input message
] []]
; section [] [button [attribute "type" "submit"] [text "Send"] ]
; section [id "contact"] [ contact_view state ]
]
]
]
(* ; section [id "see"] [ see_view state ] *)
]
(* Update *)
let update (state : state) = function
| I_am_going_for str -> { state with i_am_going_for = str }
| Select_a_pack str -> { state with select_a_pack = str }
| Side_panels str -> { state with side_panels = str }
| Side_pockets str -> { state with side_pockets = str }
| Back_panel str -> { state with back_panel = str }
| Rolltop str -> { state with rolltop = str }
| Torso str -> {state with torso = str }
| Waist str -> { state with waist = str }
| Bottle_pocket_quantity str -> { state with bottle_pocket_quantity = str }
| Bottle_pocket_colour str -> { state with bottle_pocket_colour = str }
| Lid str -> { state with lid = str }
| Waist_bag str -> { state with waist_bag = str }
| Shoulder_bag str -> { state with shoulder_bag = str }
| First_name str -> { state with first_name = str }
| Last_name str -> { state with last_name = str }
| Email str -> { state with email = str }
| Postal_address str -> { state with postal_address = str }
| Message str -> { state with message = str }
let _ =
sandbox (* very simple applications are sandbox applications *)
init (* initial state *)
view (* view function *)
update (* update function *)