open Brr
open Note
open Note_brr
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

      let _ =
        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)
      and _ =
        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)
      in

      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 ->
      let wellplaced =
        match prop with
        | None -> false
        | Some v ->
            let c = String.get (Jstr.to_string (fst v)) 0 in
            let contain = Motus_lib.Criteria.Contain (c, Some !i) in
            List.mem contain ~set:rules
      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;
          El.set_at (Jstr.v "readonly") (Some (Jstr.v "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_at (Jstr.v "readonly") (Some (Jstr.v "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)