Table projector

src/CLI/Print.re

@@ -6,6 +6,7 @@ let exp_to_segment_settings: ExpToSegment.Settings.t = {
   label_format: QuoteWhenNecessary,
   inline: false,
   fold_case_clauses: false,
+  project_tables: false,
   fold_fn_bodies: `NoFold,
   hide_fixpoints: false,
   show_filters: true,

src/haz3lcore/pretty/ExpToSegment.re

@@ -40,6 +40,7 @@ module Settings = {
       | `Text
       | `NoFold
     ],
+    project_tables: bool,
     hide_fixpoints: bool,
     show_filters: bool,
     show_unknown_as_hole: bool,
@@ -51,6 +52,7 @@ module Settings = {
     label_format: QuoteWhenNecessary,
     inline,
     fold_case_clauses: !settings.evaluation.show_case_clauses,
+    project_tables: settings.evaluation.project_tables,
     fold_fn_bodies:
       fold_fn_bodies
       |> Option.value(
@@ -68,6 +70,7 @@ module Settings = {
       label_format: QuoteWhenNecessary,
       inline,
       fold_case_clauses: false,
+      project_tables: false,
       fold_fn_bodies: `NoFold,
       hide_fixpoints: false,
       show_filters: true,
@@ -470,8 +473,8 @@ let rec parenthesize =
   | Ap(Reverse, e1, e2) =>
     Ap(
       Reverse,
-      parenthesize(e1) |> paren_assoc_at(Precedence.eqs),
-      parenthesize(e2) |> paren_at(Precedence.eqs),
+      parenthesize(e1) |> paren_at(Precedence.eqs), // Associativity is backwards because e2 goes before e1
+      parenthesize(e2) |> paren_assoc_at(Precedence.eqs),
     )
     |> rewrap
   | TypAp(e, tp) =>
@@ -1056,6 +1059,15 @@ let fold_fun_if = (condition, f_name: string, pieces, exp) =>
   | `NoFold => pieces
   };
 
+let project_table_if = (should_project, pieces) =>
+  if (should_project) {
+    switch (MakeTerm.for_projection([pieces])) {
+    | None => failwith("ExpToSegment.project_table_if")
+    | Some(any) => [ProjectorInit.init_or_noop(Table, pieces, any)]
+    };
+  } else {
+    [pieces];
+  };
 /* We assume that parentheses have already been added as necessary, and
       that the expression has no Closures or DynamicErrorHoles
    */
@@ -1157,7 +1169,10 @@ let rec exp_to_pretty = (~settings: Settings.t, exp: Exp.t): pretty => {
             ),
         ],
       );
-    wrap(exp, p_just([form(x, xs)]));
+    wrap(
+      exp,
+      p_just(form(x, xs) |> project_table_if(settings.project_tables)),
+    );
   // TODO: Add optional newlines
   | Var(v) => wrap(exp, text_to_pretty(exp |> Exp.rep_id, Sort.Exp, v))
   | BinOp(op, l, r) =>
@@ -1440,6 +1455,7 @@ let rec exp_to_pretty = (~settings: Settings.t, exp: Exp.t): pretty => {
     wrap(
       exp,
       e2
+      @ (settings.inline ? [] : [Secondary(mk_newline(Id.mk()))])
       @ [
         Tile({
           id,

src/haz3lcore/projectors/ProjectorInfo.re

@@ -12,6 +12,7 @@ let utility: ProjectorBase.utility = {
       ~settings={
         ...ExpToSegment.Settings.of_core(~inline=true, CoreSettings.off),
         show_unknown_as_hole: false,
+        fold_fn_bodies: `NoFold,
       },
     );
   let lift_syntax =

src/haz3lcore/projectors/ProjectorInit.re

@@ -15,6 +15,7 @@ let to_module = (kind: ProjectorCore.Kind.t): (module Cooked) =>
   | TextArea => (module Cook(TextAreaProj.M))
   | Livelit => (module Cook(LivelitProj.M))
   | Card => (module Cook(CardProj.M))
+  | Table => (module Cook(TableProj.M))
   | Csv => (module Cook(CSVProjector.M))
   };
 

src/haz3lcore/projectors/implementations/TableProj.re

@@ -0,0 +1,181 @@
+open Util;
+open Virtual_dom.Vdom;
+open ProjectorBase;
+open Language;
+
+let max_column_length = 12;
+
+let rec extract_labeled_tuple_entries =
+        (exp: Exp.t): option(list((LabeledTuple.label, DHExp.t))) => {
+  switch (exp.term) {
+  | Parens(e) => extract_labeled_tuple_entries(e)
+  | Tuple(es) =>
+    OptUtil.traverse(
+      (e: Exp.t) => {
+        switch (e.term) {
+        | TupLabel({term: Label(l), _}, inner) => Some((l, inner))
+        | _ => None
+        }
+      },
+      es,
+    )
+  | _ => None
+  };
+};
+
+let table_of =
+    (any: Any.t): option((list(LabeledTuple.label), list(list(Exp.t)))) =>
+  switch (any) {
+  | Exp({term: ListLit(es), _}) =>
+    switch (
+      OptUtil.traverse(
+        e => extract_labeled_tuple_entries(e) |> Option.map(List.split),
+        es,
+      )
+    ) {
+    | Some(data: list((list(string), list(TermBase.exp_t)))) =>
+      let (headers: list(list(string)), rows: list(list(TermBase.exp_t))) =
+        List.split(data);
+
+      // If all the headers aren't the same return None
+      switch (headers) {
+      | [] => None
+      | [h, ..._] when List.for_all(x => x == h, headers) =>
+        let headers = h;
+        Some((headers, rows));
+
+      | _ => None
+      };
+    | None => None
+    }
+  | _ => None
+  };
+
+let get = (info: info): (list(LabeledTuple.label), list(list(Exp.t))) =>
+  switch (info.syntax |> info.utility.seg_to_term) {
+  | Some(s) =>
+    switch (table_of(s)) {
+    | Some(s) => s
+    | None => failwith("TextArea: get: Not a table")
+    }
+  | None => failwith("TextArea: get: Not a table")
+  };
+
+let len_seg = (utility: utility, seg: Segment.t): int =>
+  seg |> utility.seg_to_string |> String.length;
+
+let seg_of_exp = (utility: utility, exp: Exp.t): (Segment.t, int) => {
+  let seg = utility.term_to_seg(Exp(exp));
+  (seg, len_seg(utility, seg));
+};
+
+let abbreviated_seg_of =
+    (utility: utility, available: int, exp: Exp.t): (Segment.t, int) => {
+  let (abbr_exp, _length) =
+    exp |> DHExp.strip_ascriptions |> Abbreviate.abbreviate_exp(~available);
+  seg_of_exp(utility, abbr_exp);
+};
+let length_cls = (length: int): string =>
+  if (length > 10) {
+    "extra";
+  } else if (length > 9) {
+    "s6";
+  } else if (length > 8) {
+    "s5";
+  } else if (length > 7) {
+    "s4";
+  } else if (length > 6) {
+    "s3";
+  } else if (length > 5) {
+    "s2";
+  } else if (length > 4) {
+    "s1";
+  } else {
+    "s0";
+  };
+let value_view = (_info: info, utility: utility, view_seg, exp) => {
+  let (seg, length) = abbreviated_seg_of(utility, max_column_length, exp);
+
+  Node.div(
+    ~attrs=[Attr.classes(["value", length_cls(length)])],
+    [view_seg(Sort.Exp, seg)],
+  );
+};
+
+let table =
+    (
+      info,
+      ~parent as _: external_action => Ui_effect.t(unit),
+      (headers, rows): (list(LabeledTuple.label), list(list(Exp.t))),
+      ~view_seg: (Sort.t, Segment.t) => Node.t,
+    ) =>
+  Node.table(
+    ~attrs=[Attr.classes(["table"])],
+    [
+      Node.thead([
+        Node.tr(List.map(h => Node.th([Node.text(h)]), headers)),
+      ]),
+      Node.tbody(
+        List.map(
+          row =>
+            Node.tr(
+              List.map(
+                e => Node.td([value_view(info, info.utility, view_seg, e)]),
+                row,
+              ),
+            ),
+          rows,
+        ),
+      ),
+    ],
+  );
+
+module M: Projector = {
+  [@deriving (show({with_path: false}), sexp, yojson)]
+  type model = unit;
+  [@deriving (show({with_path: false}), sexp, yojson)]
+  type action = unit;
+
+  let init = (any: Any.t) =>
+    switch (table_of(any)) {
+    | Some(_) => Some()
+    | None => None
+    };
+
+  let focusable =
+    Focusable.{
+      pointer: None,
+      keyboard: None,
+    };
+  let dynamics = false;
+  let placeholder = (_, info) => {
+    let (header, rows): (list(string), list(list(TermBase.exp_t))) =
+      info |> get;
+    let max_header_length =
+      header |> List.map(String.length) |> List.fold_left((+), 0);
+    let max_row_length =
+      rows
+      |> List.map(row =>
+           row
+           |> List.map(e =>
+                Abbreviate.abbreviate_exp(~available=max_column_length, e)
+                |> snd
+              )
+           |> List.fold_left((+), 0, _)
+         )
+      |> List.fold_left(max, 0, _);
+    let max_length = max(max_header_length, max_row_length);
+
+    let num_rows = List.length(rows);
+    let num_cols = List.length(header);
+    ProjectorCore.Shape.{
+      vertical: Block(min(num_rows + 1, 10)), // +1 for header row
+      /* +2 for left and right padding */
+      horizontal: 4 + max_length * 1 + num_cols * 2 // +2 for left and right padding
+    };
+  };
+  let update = (model, _, _) => model;
+
+  let view = ({info, parent, view_seg, _}: View.args(model, action)): View.t =>
+    View.mk(table(info, ~view_seg, ~parent, info |> get));
+};

src/haz3lcore/zipper/action/Introduce.re

@@ -245,6 +245,7 @@ module Make =
           label_format: QuoteWhenNecessary,
           inline: true,
           fold_case_clauses: false,
+          project_tables: false,
           fold_fn_bodies: `NoFold,
           hide_fixpoints: false,
           show_filters: true,

src/language/CoreSettings.re

@@ -10,6 +10,7 @@ module Evaluation = {
     show_case_steps: bool,
     show_lookup_steps: bool,
     show_stepper_filters: bool,
+    project_tables: bool,
     // TODO[Matt]: Move this to somewhere where it is a per-scratch setting
     stepper_history: bool,
     show_settings: bool,
@@ -25,6 +26,7 @@ module Evaluation = {
     show_case_steps: false,
     show_lookup_steps: false,
     show_stepper_filters: false,
+    project_tables: false,
     stepper_history: false,
     show_settings: false,
     show_hidden_steps: false,

src/language/ProjectorKind.re

@@ -16,6 +16,7 @@ type t =
   | Card
   | Livelit
   | TextArea
+  | Table
   | Csv;
 
 let livelit_projectors: list(t) = [
@@ -27,6 +28,7 @@ let livelit_projectors: list(t) = [
   TextArea,
   Card,
   Livelit,
+  Table,
 ];
 
 /* Note: Probe intentionally excluded - probes use separate action path */
@@ -51,6 +53,7 @@ let name = (p: t): string =>
   | Livelit => "livelit"
   | TextArea => "text"
   | Csv => "csv"
+  | Table => "table"
   };
 
 /* This must be updated and kept 1-to-1 with the above
@@ -68,6 +71,7 @@ let of_name = (p: string): t =>
   | "livelit" => Livelit
   | "card" => Card
   | "csv" => Csv
+  | "table" => Table
   | _ => failwith("Unknown projector kind")
   };