1 files changed, 98 insertions, 0 deletions
diff --git a/motus/lib/validity.ml b/motus/lib/validity.ml
new file mode 100644
index 0000000..ae85f04
--- /dev/null
+++ b/motus/lib/validity.ml
@@ -0,0 +1,98 @@
+open StdLabels
+
+(* Enclose the type definition into a warning removval in order to hide some
+   auto-generated values *)
+[@@@warning "-32"]
+
+type t =
+  | Wellplaced
+  | Misplaced
+  | Missing
+[@@deriving enum]
+
+[@@@warning "+32"]
+
+let m = Float.of_int (1 + max)
+
+(** Get the index of a validity result *)
+let index_of_result : t array -> int =
+ fun elems ->
+  let _, value =
+    Array.fold_left elems ~init:(0., 0.) ~f:(fun (pos, acc) content ->
+        let v = Float.of_int (to_enum content) in
+        let acc' = acc +. (v *. (m ** pos)) in
+        (pos +. Float.one, acc') )
+  in
+  Float.to_int value
+
+
+let index_to_result : base:int -> int -> t array =
+ fun ~base n ->
+  let rec _f acc n i =
+    let next = Float.round (n /. m)
+    and rem = Float.(to_int @@ rem n m) in
+
+    match (rem, i) with
+    | _, 0 -> Array.of_list acc
+    | n, _ ->
+      ( match of_enum n with
+      | None -> Array.of_list acc
+      | Some v -> _f (v :: acc) next (i - 1) )
+  in
+  _f [] (Float.of_int n) base
+
+
+(** Build a sequence of all the possible status for a given number of letters *)
+let sequence : int -> t array Seq.t =
+ fun base ->
+  let max_element = Float.to_int @@ (m ** Float.of_int base) in
+
+  Seq.unfold
+    (fun n ->
+      if n < max_element then Some (index_to_result ~base n, n + 1) else None )
+    0
+
+
+let compare_words : string -> ref:string -> t array option =
+ fun w1 ~ref ->
+  let l1 = String.length w1 in
+  if l1 <> String.length ref
+  then None
+  else
+    let result =
+      Array.init l1 ~f:(fun i ->
+          let c1 = String.get w1 i
+          and c2 = String.get ref i in
+
+          let state =
+            if Char.equal c1 c2
+            then Wellplaced
+            else if String.contains ref c1
+            then Misplaced
+            else Missing
+          in
+          state )
+    in
+    Some result
+
+
+let to_criteria : char -> int -> t -> Criteria.t list -> Criteria.t list =
+ fun c i t acc ->
+  match t with
+  | Wellplaced -> Criteria.add (Criteria.Contain (c, Some i)) acc
+  | Missing -> Criteria.add (Criteria.NotContain (c, None)) acc
+  | Misplaced ->
+      Criteria.add
+        (Criteria.NotContain (c, Some i))
+        (Criteria.add (Criteria.Contain (c, None)) acc)
+
+
+let to_criterias : string -> t array -> Criteria.t list =
+ fun word t ->
+  let l, _ =
+    Array.fold_left t ~init:([], 0) ~f:(fun (acc, i) t ->
+        let acc = to_criteria (String.get word i) i t acc in
+        (acc, i + 1) )
+  in
+
+  List.rev l