(* file: working.ml *)
(* Goal *)
(*
Declared in data.ml:
type fabric_data = { fabric : string; colour : string; in_stock : bool }
*)
match g "Less Weight"
"More Colour"
"More Durable"
(* Pack and volume*)
(* Need this type to transfer properly between pack volumes while maintaining style, colour info *)
(* Torso length *)
match t "56 XL"
"53 L"
"50 L"
"48 M"
"45 M"
"43 S"
(* Waist belt size *)
match w "75 M" "80 L"
(* Messages *)
(* Pack data structures *)
match p
match v
match record_of_pack p str
match record_of_pack p featues
match v "65l" "55l" "45l"
match s "Classic" "Alpine"
(* Fabric data structures *)
match g f.light f.colour f.durable
(* TO DO: need to filter panel, pocket, rolltop match for in_stock, but at present all fabric in stock*)
match p
match p
match p
match s "Sold" "Not sold"
(* Model *)
s.query ^ " | " ^ string_of_volume s.volume ^ " | " ^ string_of_style s.style
^ " | " ^ string_of_pack s.pack ^ " | " ^ string_of_goal s.goal ^ " | "
^ s.back_panel.fabric ^ " | " ^ s.rolltop.fabric ^ " | "
^ s.side_panels.fabric ^ " | " ^ s.side_pockets.fabric ^ " | "
^ string_of_torso s.torso ^ " | " ^ string_of_waist s.waist ^ " | " ^ s.email
^ " | "
^ string_of_buy_now s.buy_now
(* Takes first n items from a list, used to truncate length of state history *)
if n = 0 || lst = [ then [ else hd lst :: take
let p = record_of_pack s.pack in
match s.goal p.price + p.ultra_price
p.price
p.price
(* Views*)
let open Html in
let open Attribute in
node "section" attrs nodes in
section [
let header_view =
let open Html in
let open Attribute in
node "nav" attrs nodes in
node "img" attrs nodes in
node "a" attrs nodes in
nav [
let open Html in
let open Attribute in
node "form" attrs nodes in
Query str in
form [
let open Html in
let open Attribute in
button
let open Html in
let open Attribute in
node "section" attrs nodes in
section [
let open Html in
let open Attribute in
node "section" attrs nodes in
section [
match p a45_view
a55_view
a65_view
c45_view
c55_view
c65_view
let open Html in
let open Attribute in
node "article" attrs nodes in
node "footer" attrs nodes in
div [
let open Html in
let open Attribute in
node "section" attrs nodes in
node "details" attrs nodes in
node "summary" attrs nodes in
node "hr" attrs nodes in
let packs = list_of_volume state.volume in
let card = pack_card state in
section
(* fbfcfc *)
let open Html in
let open Attribute in
node "details" attrs nodes in
node "summary" attrs nodes in
details
let open Html in
let open Attribute in
node "section" attrs nodes in
Back_panel f in
Side_panels f in
Side_pockets f in
Rolltop f in
section [
let open Html in
let open Attribute in
node "section" attrs nodes in
node "details" attrs nodes in
node "summary" attrs nodes in
node "hr" attrs nodes in
node "img" attrs nodes in
section [
let open Html in
let open Attribute in
node "section" attrs nodes in
node "details" attrs nodes in
node "summary" attrs nodes in
node "hr" attrs nodes in
node "img" attrs nodes in
section [
let open Html in
let open Attribute in
Email str in
node "section" attrs nodes in
node "small" attrs nodes in
section [
let open Html in
let open Attribute in
div [
(* Helper for Update *)
match vs_tup record_of_pack C65
record_of_pack C55
record_of_pack C45
record_of_pack A65
record_of_pack A55
record_of_pack A45
(* Checks that the state of side_panels, side_pockets, back_panel, rolltop, is
possible in the fabric_data list and returns plausible values.
Run for any change in goal or pack *)
let pan = panel_match p |> get_fabric_by_goal g in
if memq state.back_panel pan then state.back_panel else hd pan
let pan = panel_match p |> get_fabric_by_goal g in
if memq state.side_panels pan then state.side_panels else hd pan
let pan = pocket_match p |> get_fabric_by_goal g in
if memq state.side_pockets pan then state.side_pockets else hd pan
let r = rolltop_match p |> get_fabric_by_goal g in
if memq state.rolltop r then state.rolltop else hd r
(* Update *)
let new_state =
match msg
(* never called *)
(* never called *)
in
if length new_state.history < 20 then
else
let _ = sandbox init view update