From ebc6c6e6479e12169fb2b839c7728e937e6137dc Mon Sep 17 00:00:00 2001
From: David Moon <dmoon1221@gmail.com>
Date: Mon, 19 Aug 2024 16:49:32 -0400
Subject: [PATCH] fix grouter bug caused by not passing in cells in same
 orientation as walks

---
 src/core/editor/Effects.re  |  1 +
 src/core/parser/Grouter.re  |  4 +++
 src/core/parser/Melder.re   |  2 +-
 src/core/structure/Oblig.re | 51 ++++++++++++++++++++++---------------
 4 files changed, 36 insertions(+), 22 deletions(-)

diff --git a/src/core/editor/Effects.re b/src/core/editor/Effects.re
index 21a225ca..625716dd 100644
--- a/src/core/editor/Effects.re
+++ b/src/core/editor/Effects.re
@@ -1,3 +1,4 @@
+[@deriving (show({with_path: false}), sexp, yojson)]
 type t =
   | Insert(Token.t)
   | Remove(Token.t);
diff --git a/src/core/parser/Grouter.re b/src/core/parser/Grouter.re
index a3f466bb..21845d21 100644
--- a/src/core/parser/Grouter.re
+++ b/src/core/parser/Grouter.re
@@ -92,6 +92,7 @@ let fill_default =
 
 // assumes cs already squashed sans padding
 let fill_swing = (cs: Cells.t, sw: Walk.Swing.t, ~from: Dir.t) => {
+  let cs = Dir.pick(from, (List.rev, Fun.id), cs);
   let (bot, top) = Walk.Swing.(bot(sw), top(sw));
   switch (bot) {
   | Space(nt) =>
@@ -159,5 +160,8 @@ let fill = (~repair, ~from, cs, (swings, stances): Walk.t) => {
   Chain.mk(cs, toks);
 };
 
+// pick a walk from ws that best accommodates the cells in cs, ie minimizes
+// obligation delta. the given cells are expected to be oriented the same way as the
+// given walks according to from.
 let pick = (~repair=false, ~from: Dir.t, cs: list(Cell.t), ws: list(Walk.t)) =>
   Oblig.Delta.minimize(~to_zero=!repair, fill(~repair, ~from, cs), ws);
diff --git a/src/core/parser/Melder.re b/src/core/parser/Melder.re
index d72de1d2..e61a1f7d 100644
--- a/src/core/parser/Melder.re
+++ b/src/core/parser/Melder.re
@@ -123,7 +123,7 @@ let connect_eq =
     let/ () = repair ? rm_ghost_and_go(onto, fill) : None;
     let face = Terr.face(onto).mtrl;
     Walker.walk_eq(~from=d, Node(face), Node(t.mtrl))
-    |> Grouter.pick(~repair, ~from=d, fill)
+    |> Grouter.pick(~repair, ~from=d, List.rev(fill))
     |> Option.map(baked => Grouted.connect_eq(t, baked, onto, ~onto=d));
   }
   and rm_ghost_and_go = (onto, fill) =>
diff --git a/src/core/structure/Oblig.re b/src/core/structure/Oblig.re
index c3cab81c..ef950ab3 100644
--- a/src/core/structure/Oblig.re
+++ b/src/core/structure/Oblig.re
@@ -1,18 +1,32 @@
+open Sexplib.Std;
+open Ppx_yojson_conv_lib.Yojson_conv.Primitives;
 open Stds;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
-type t =
-  | Missing_meld // convex grout
-  | Missing_tile // ghost tile
-  | Incon_meld // pre/postfix grout
-  | Extra_meld // infix grout
-  | Unmolded_tok;
+module Ord = {
+  [@deriving (show({with_path: false}), sexp, yojson)]
+  type t =
+    | Missing_meld // convex grout
+    | Missing_tile // ghost tile
+    | Incon_meld // pre/postfix grout
+    | Extra_meld // infix grout
+    | Unmolded_tok;
+
+  // low to high severity
+  // (unmolded tile severity doesn't matter in that it is always last resort
+  // after using other oblig severities to compare available mold options)
+  let all = [
+    Missing_meld,
+    Missing_tile,
+    Incon_meld,
+    Extra_meld,
+    Unmolded_tok,
+  ];
+  let severity = o => Option.get(Lists.find_index((==)(o), all));
+  let compare = (l, r) => Int.compare(severity(l), severity(r));
+};
+include Ord;
 
-// low to high severity
-// (unmolded tile severity doesn't matter in that it is always last resort
-// after using other oblig severities to compare available mold options)
-let all = [Missing_meld, Missing_tile, Incon_meld, Extra_meld, Unmolded_tok];
-let severity = o => Option.get(Lists.find_index((==)(o), all));
+module Map = Maps.Make(Ord);
 
 let of_token = (tok: Token.t) =>
   switch (tok.mtrl) {
@@ -25,14 +39,9 @@ let of_token = (tok: Token.t) =>
     Label.is_complete(tok.text, lbl) ? None : Some(Missing_tile)
   };
 
-module Ord = {
-  type nonrec t = t;
-  let compare = (l, r) => Int.compare(severity(l), severity(r));
-};
-module Map = Map.Make(Ord);
-
 module Delta = {
   include Map;
+  [@deriving (show({with_path: false}), sexp, yojson)]
   type t = Map.t(int);
   let find = (o, map) => Option.value(find_opt(o, map), ~default=0);
 
@@ -41,10 +50,10 @@ module Delta = {
   let incr = (o, map) => add(o, find(o, map) + 1, map);
 
   let compare = (l, r) =>
-    List.fold_right(
-      (o, c) => c != 0 ? c : Int.compare(find(o, l), find(o, r)),
+    Lists.fold_right(
+      ~f=(o, c) => c != 0 ? c : Int.compare(find(o, l), find(o, r)),
       all,
-      0,
+      ~init=0,
     );
 
   let add_effect =