open Brr open Note open Brr_note open StdLabels type elements = Brr.El.t list (** Depending of the class, extract the letter validity. If no class is specified, consider the letter is at the right position. *) let get_validity_from_element : El.t -> Motus_lib.Validity.t = fun el -> if El.class' (Jstr.v "missing") el then Missing else if El.class' (Jstr.v "misplaced") el then Misplaced else Wellplaced let get_rules : elements -> State.proposition = fun t -> List.map ~f:(fun input -> let value = El.prop El.Prop.value input in if Jstr.equal Jstr.empty value then None else let validity = get_validity_from_element input in Some (value, validity) ) t let get_class : Motus_lib.Validity.t -> Jstr.t = function | Wellplaced -> Jstr.v "wellplaced" | Misplaced -> Jstr.v "misplaced" | _ -> Jstr.v "missing" (** Create the field list modifiied by the user *) let make : int -> (int * Jstr.t * Motus_lib.Validity.t) E.send -> elements = fun len change_sender -> List.init ~len ~f:(fun i -> let input = El.input ~at: At. [ type' (Jstr.v "text") ; v (Jstr.v "maxLength") (Jstr.v "1") ; value Jstr.empty ; class' (Jstr.v "missing") ; v (Jstr.v "readonly") (Jstr.v "true") ] () in Ev.listen Ev.change (fun _ -> let validity = get_validity_from_element input in change_sender (i, El.prop El.Prop.value input, validity) ) (El.as_target input); Ev.listen Ev.click (fun _ -> let validity = match get_validity_from_element input with | Missing -> Motus_lib.Validity.Misplaced | Misplaced -> Motus_lib.Validity.Wellplaced | Wellplaced -> Motus_lib.Validity.Missing in change_sender (i, El.prop El.Prop.value input, validity) ) (El.as_target input); El.td [ input ] ) (** Set the element class depending of the proposition validity for each letter *) let set_with_props : State.proposition -> elements -> Motus_lib.Criteria.t list -> unit = fun current_prop fields rules -> let i = ref 0 in List.iter2 current_prop fields ~f:(fun prop field -> (* Check if we have a rule for this letter *) let wellplaced = List.exists rules ~f:(function | Motus_lib.Criteria.Contain (_, Some i') when !i = i' -> true | _ -> false ) in incr i; match (wellplaced, El.children field, prop) with | true, hd :: _, Some (letter, _) -> El.set_prop El.Prop.value letter hd; El.set_class (Jstr.v "wellplaced") true hd; El.set_class (Jstr.v "misplaced") false hd; El.set_class (Jstr.v "missing") false hd; El.set_at (Jstr.v "readonly") (Some (Jstr.v "true")) hd | _, hd :: _, None -> El.set_class (Jstr.v "wellplaced") false hd; El.set_class (Jstr.v "misplaced") false hd; El.set_class (Jstr.v "missing") false hd | false, hd :: _, Some (letter, validity) -> El.set_prop El.Prop.value letter hd; El.set_class (Jstr.v "wellplaced") false hd; El.set_class (Jstr.v "misplaced") false hd; El.set_class (Jstr.v "missing") false hd; El.set_class (get_class validity) true hd | _, [], _ -> () ) let build : El.t -> int S.t -> State.proposition S.t = fun container length -> (* Build the element list *) S.bind length (fun len -> let elements = List.init ~len ~f:(fun _ -> let input = El.input ~at: At. [ type' (Jstr.v "text") ; v (Jstr.v "maxLength") (Jstr.v "1") ; value Jstr.empty ] () in input ) in let events = List.mapi ~f:(fun i input -> Evr.on_el Ev.input (fun _ -> let value = El.prop El.Prop.value input in if Jstr.equal Jstr.empty value then (i, None) else let validity = Motus_lib.Validity.Wellplaced in (i, Some (Jstr.uppercased value, validity)) ) input ) elements (* As the state is in a list, we have no way to be sure that the list length is the same as the number of elements… except to rely on the compiler contract. But this would cause nasty bug if we had a difference here. *) and init_prop = List.init ~len ~f:(fun _ -> None) in (* Replace the children in the element *) El.set_children container [ El.table [ (* The table has only one row *) El.tr (List.map elements ~f:(fun el -> El.td [ (* Each cell is the input element *) el ] ) ) ] ]; let change = E.select events |> E.map (fun (position, value) acc -> List.mapi acc ~f:(fun i prop -> if i <> position then prop else value ) ) in let initial_proposition = S.accum init_prop change in initial_proposition )