| 1 | open Core |
| 2 | |
| 3 | type cell = string * (string -> string) |
| 4 | |
| 5 | and row = cell list |
| 6 | |
| 7 | module Tabular = struct |
| 8 | let maximum_lengths rows = |
| 9 | rows |
| 10 | |> List.foldi ~init:[] ~f:(fun index accm row -> |
| 11 | let row_maximums = |
| 12 | row |> List.map ~f:(fun cell -> fst cell |> String.length) |
| 13 | in |
| 14 | if Int.equal index 0 then row_maximums |
| 15 | else List.map2_exn accm row_maximums ~f:Int.max) |
| 16 | |
| 17 | let fixed rows = |
| 18 | let dimensions = rows |> maximum_lengths in |
| 19 | let lines = |
| 20 | rows |
| 21 | |> List.fold ~init:[] ~f:(fun accm row -> |
| 22 | let line = |
| 23 | row |
| 24 | |> List.foldi ~init:"" ~f:(fun index line cell -> |
| 25 | let content, paint_fn = cell in |
| 26 | let padding = |
| 27 | List.nth_exn dimensions index |
| 28 | - String.length content + 1 |
| 29 | in |
| 30 | let padding = String.make padding ' ' in |
| 31 | let line = line ^ (content |> paint_fn) ^ padding in |
| 32 | line) |
| 33 | in |
| 34 | |
| 35 | line :: accm) |
| 36 | in |
| 37 | lines |> List.rev |
| 38 | |
| 39 | let wide ?(pivot = 1) ~width rows = |
| 40 | let dimensions = rows |> maximum_lengths in |
| 41 | let left, right = |
| 42 | rows |
| 43 | |> List.fold ~init:([], []) ~f:(fun accm row -> |
| 44 | let left, right = List.split_n row pivot in |
| 45 | (left :: fst accm, right :: snd accm)) |
| 46 | in |
| 47 | let left = left |> fixed in |
| 48 | let right = right |> fixed in |
| 49 | let column_length = dimensions |> List.reduce_exn ~f:( + ) in |
| 50 | let n_columns = dimensions |> List.length in |
| 51 | let total_length = width - (column_length + n_columns) in |
| 52 | let padding = String.make total_length ' ' in |
| 53 | List.map2_exn left right ~f:(fun left right -> |
| 54 | String.concat [ left; padding; right ]) |
| 55 | |> List.rev |
| 56 | |
| 57 | end |
| 58 | |
| 59 | module Hierarchical = struct |
| 60 | type tree = Tree of (string * tree list) |
| 61 | |
| 62 | let get_padding = function true -> "│ " | false -> " " |
| 63 | |
| 64 | let get_edge = function true -> "└──" | false -> "├──" |
| 65 | |
| 66 | let fill ~last ~state = |
| 67 | match List.length state with |
| 68 | | 0 -> [] |
| 69 | | 1 -> [ last |> get_edge ] |
| 70 | | len -> |
| 71 | let state = List.slice state 0 (len - 1) in |
| 72 | let padding = List.map ~f:get_padding state in |
| 73 | List.append padding [ last |> get_edge ] |
| 74 | |
| 75 | let rec to_lines ?(state = []) ?(last = false) next = |
| 76 | let (Tree next) = next in |
| 77 | let title, children = next in |
| 78 | match List.length children with |
| 79 | | 0 -> |
| 80 | (* leaf *) |
| 81 | List.append (fill ~last ~state) [ title; "\n" ] |
| 82 | | n_children -> |
| 83 | (* node *) |
| 84 | List.foldi |
| 85 | ~init: |
| 86 | [ List.append (fill ~last ~state) [ title; "\n" ] |> String.concat ] |
| 87 | ~f:(fun i accm node -> |
| 88 | let is_last = Int.equal i (n_children - 1) in |
| 89 | let state = List.append state [ phys_equal is_last false ] in |
| 90 | let lines = to_lines ~state ~last:is_last node in |
| 91 | List.append accm lines) |
| 92 | children |
| 93 | |
| 94 | let to_string tree = "\n" ^ (tree |> to_lines |> String.concat) |
| 95 | end |