mirror of
https://github.com/chshersh/github-tui.git
synced 2024-09-11 18:37:56 +03:00
Format OCaml code
This commit is contained in:
parent
492f54e246
commit
096f32b9bd
@ -2,3 +2,5 @@ version = 0.26.1
|
|||||||
profile = default
|
profile = default
|
||||||
break-cases = fit-or-vertical
|
break-cases = fit-or-vertical
|
||||||
break-infix = wrap-or-vertical
|
break-infix = wrap-or-vertical
|
||||||
|
doc-comments = before
|
||||||
|
type-decl = sparse
|
||||||
|
4
bin/dune
4
bin/dune
@ -1,6 +1,4 @@
|
|||||||
(executable
|
(executable
|
||||||
(public_name github_tui)
|
(public_name github_tui)
|
||||||
(name main)
|
(name main)
|
||||||
(libraries
|
(libraries github_tui))
|
||||||
github_tui
|
|
||||||
))
|
|
||||||
|
11
lib/cli.ml
11
lib/cli.ml
@ -6,15 +6,20 @@ let repo_arg =
|
|||||||
|
|
||||||
let path_arg =
|
let path_arg =
|
||||||
let doc = "Path to a local directory of a GitHub repository" in
|
let doc = "Path to a local directory of a GitHub repository" in
|
||||||
Arg.(value & opt string "." & info ["d"; "directory"] ~docv:"DIRECTORY_PATH" ~doc)
|
Arg.(
|
||||||
|
value
|
||||||
|
& opt string "."
|
||||||
|
& info [ "d"; "directory" ] ~docv:"DIRECTORY_PATH" ~doc)
|
||||||
|
|
||||||
let gh_tui_t = Term.(const Tui.start $ repo_arg $ path_arg)
|
let gh_tui_t = Term.(const Tui.start $ repo_arg $ path_arg)
|
||||||
|
|
||||||
let cmd =
|
let cmd =
|
||||||
let doc = "TUI of a GitHub repository" in
|
let doc = "TUI of a GitHub repository" in
|
||||||
let man = [
|
let man =
|
||||||
|
[
|
||||||
`S Manpage.s_bugs;
|
`S Manpage.s_bugs;
|
||||||
`P "Submit bug reports at: https://github.com/chshersh/github-tui/issues" ]
|
`P "Submit bug reports at: https://github.com/chshersh/github-tui/issues";
|
||||||
|
]
|
||||||
in
|
in
|
||||||
let info = Cmd.info "gh-tui" ~version:"0.1.0" ~doc ~man in
|
let info = Cmd.info "gh-tui" ~version:"0.1.0" ~doc ~man in
|
||||||
Cmd.v info gh_tui_t
|
Cmd.v info gh_tui_t
|
||||||
|
9
lib/dune
9
lib/dune
@ -2,11 +2,4 @@
|
|||||||
|
|
||||||
(library
|
(library
|
||||||
(name github_tui)
|
(name github_tui)
|
||||||
(libraries
|
(libraries ANSITerminal cmdliner ezcurl minttea uuseg.string))
|
||||||
ANSITerminal
|
|
||||||
cmdliner
|
|
||||||
ezcurl
|
|
||||||
minttea
|
|
||||||
uuseg.string
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
39
lib/fs.ml
39
lib/fs.ml
@ -13,10 +13,10 @@ let file_name = function
|
|||||||
*)
|
*)
|
||||||
let order_files t1 t2 =
|
let order_files t1 t2 =
|
||||||
match (t1, t2) with
|
match (t1, t2) with
|
||||||
| (Dir _, File _) -> -1
|
| Dir _, File _ -> -1
|
||||||
| (File _, Dir _) -> 1
|
| File _, Dir _ -> 1
|
||||||
| (File name_1, File name_2) -> String.compare name_1 name_2
|
| File name_1, File name_2 -> String.compare name_1 name_2
|
||||||
| (Dir (name_1, _), Dir (name_2, _)) -> String.compare name_1 name_2
|
| Dir (name_1, _), Dir (name_2, _) -> String.compare name_1 name_2
|
||||||
|
|
||||||
let rec sort_tree = function
|
let rec sort_tree = function
|
||||||
| File name -> File name
|
| File name -> File name
|
||||||
@ -26,40 +26,32 @@ let rec sort_tree = function
|
|||||||
|
|
||||||
let rec to_tree path =
|
let rec to_tree path =
|
||||||
if Sys.is_directory path then
|
if Sys.is_directory path then
|
||||||
let children = Array.map
|
let children =
|
||||||
|
Array.map
|
||||||
(fun child_name -> to_tree (Filename.concat path child_name))
|
(fun child_name -> to_tree (Filename.concat path child_name))
|
||||||
(Sys.readdir path)
|
(Sys.readdir path)
|
||||||
in
|
in
|
||||||
let dirname = Filename.basename path ^ "/" in
|
let dirname = Filename.basename path ^ "/" in
|
||||||
Dir (dirname, children)
|
Dir (dirname, children)
|
||||||
else
|
else File (Filename.basename path)
|
||||||
File (Filename.basename path)
|
|
||||||
|
|
||||||
let read_tree path =
|
let read_tree path = path |> to_tree |> sort_tree
|
||||||
path |> to_tree |> sort_tree
|
|
||||||
|
|
||||||
type cursor =
|
type cursor = {
|
||||||
{
|
|
||||||
pos : int;
|
pos : int;
|
||||||
files : tree array;
|
files : tree array;
|
||||||
}
|
}
|
||||||
|
|
||||||
let file_at cursor =
|
let file_at cursor =
|
||||||
if cursor.pos < 0 || Array.length cursor.files <= cursor.pos
|
if cursor.pos < 0 || Array.length cursor.files <= cursor.pos then None
|
||||||
then None
|
|
||||||
else Some cursor.files.(cursor.pos)
|
else Some cursor.files.(cursor.pos)
|
||||||
|
|
||||||
type zipper =
|
type zipper = {
|
||||||
{
|
|
||||||
parents : cursor list;
|
parents : cursor list;
|
||||||
current : cursor;
|
current : cursor;
|
||||||
}
|
}
|
||||||
|
|
||||||
let zip_it trees =
|
let zip_it trees = { parents = []; current = { pos = 0; files = trees } }
|
||||||
{
|
|
||||||
parents = [];
|
|
||||||
current = { pos = 0; files = trees; }
|
|
||||||
}
|
|
||||||
|
|
||||||
let zipper_parents zipper =
|
let zipper_parents zipper =
|
||||||
List.filter_map
|
List.filter_map
|
||||||
@ -87,15 +79,14 @@ let go_next zipper =
|
|||||||
| None -> zipper
|
| None -> zipper
|
||||||
| Some (File _) -> zipper
|
| Some (File _) -> zipper
|
||||||
| Some (Dir (_, next)) ->
|
| Some (Dir (_, next)) ->
|
||||||
if Array.length next = 0 then
|
if Array.length next = 0 then zipper
|
||||||
zipper
|
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
parents = cursor :: zipper.parents;
|
parents = cursor :: zipper.parents;
|
||||||
current = { pos = 0; files = next; }
|
current = { pos = 0; files = next };
|
||||||
}
|
}
|
||||||
|
|
||||||
let go_back zipper =
|
let go_back zipper =
|
||||||
match zipper.parents with
|
match zipper.parents with
|
||||||
| [] -> zipper
|
| [] -> zipper
|
||||||
| current :: parents -> { parents; current; }
|
| current :: parents -> { parents; current }
|
||||||
|
@ -3,16 +3,14 @@ let github_api_url = "https://api.github.com/graphql"
|
|||||||
let query query_body =
|
let query query_body =
|
||||||
let token = Sys.getenv "GITHUB_TOKEN" in
|
let token = Sys.getenv "GITHUB_TOKEN" in
|
||||||
let response =
|
let response =
|
||||||
Ezcurl.post
|
Ezcurl.post ~params:[]
|
||||||
~params:[]
|
|
||||||
~headers:
|
~headers:
|
||||||
[
|
[
|
||||||
("Authorization", "bearer " ^ token);
|
("Authorization", "bearer " ^ token);
|
||||||
("User-Agent", "chshersh/github-tui")
|
("User-Agent", "chshersh/github-tui");
|
||||||
]
|
]
|
||||||
~content:(`String (Printf.sprintf "{ \"query\": %S }" query_body))
|
~content:(`String (Printf.sprintf "{ \"query\": %S }" query_body))
|
||||||
~url:github_api_url
|
~url:github_api_url ()
|
||||||
()
|
|
||||||
in
|
in
|
||||||
match response with
|
match response with
|
||||||
| Error (_code, msg) -> Printf.sprintf "Error: %s" msg
|
| Error (_code, msg) -> Printf.sprintf "Error: %s" msg
|
||||||
|
@ -8,8 +8,5 @@ let in_between ~sep list =
|
|||||||
| x :: xs -> x :: loop xs
|
| x :: xs -> x :: loop xs
|
||||||
|
|
||||||
let generate n f =
|
let generate n f =
|
||||||
let rec loop i =
|
let rec loop i = if i = n then [] else f i :: loop (i + 1) in
|
||||||
if i = n
|
loop 0
|
||||||
then []
|
|
||||||
else f i :: loop (i + 1)
|
|
||||||
in loop 0
|
|
||||||
|
@ -19,52 +19,39 @@ let col = function
|
|||||||
| [] -> Empty
|
| [] -> Empty
|
||||||
| hd :: tl -> List.fold_left (fun l r -> Vertical (l, r)) hd tl
|
| hd :: tl -> List.fold_left (fun l r -> Vertical (l, r)) hd tl
|
||||||
|
|
||||||
type chunk =
|
type chunk = {
|
||||||
{
|
|
||||||
styles : styles;
|
styles : styles;
|
||||||
string : string;
|
string : string;
|
||||||
}
|
}
|
||||||
|
|
||||||
let fmt_chunk {styles; string} =
|
let fmt_chunk { styles; string } = ANSITerminal.sprintf styles "%s" string
|
||||||
ANSITerminal.sprintf styles "%s" string
|
|
||||||
|
|
||||||
let mk_padding_chunk n =
|
let mk_padding_chunk n =
|
||||||
let padding = String.make n ' ' in
|
let padding = String.make n ' ' in
|
||||||
{ styles = []; string = padding }
|
{ styles = []; string = padding }
|
||||||
|
|
||||||
type line =
|
type line = { chunks : chunk list }
|
||||||
{
|
|
||||||
chunks: chunk list
|
|
||||||
}
|
|
||||||
|
|
||||||
let fmt_line line =
|
let fmt_line line = line.chunks |> List.map fmt_chunk |> String.concat ""
|
||||||
line.chunks
|
|
||||||
|> List.map fmt_chunk
|
|
||||||
|> String.concat ""
|
|
||||||
|
|
||||||
let line_len line =
|
let line_len line =
|
||||||
List.fold_left
|
List.fold_left
|
||||||
(fun acc { string; _ } -> acc + String_extra.graphemes_len string)
|
(fun acc { string; _ } -> acc + String_extra.graphemes_len string)
|
||||||
0
|
0 line.chunks
|
||||||
line.chunks
|
|
||||||
|
|
||||||
let zip_lines (l : line list) (r : line list) =
|
let zip_lines (l : line list) (r : line list) =
|
||||||
let max_len_l = List.map line_len l |> List.fold_left max 0 in
|
let max_len_l = List.map line_len l |> List.fold_left max 0 in
|
||||||
|
|
||||||
let rec zip l r =
|
let rec zip l r =
|
||||||
match (l, r) with
|
match (l, r) with
|
||||||
| (l, []) ->
|
| l, [] -> l
|
||||||
l
|
| [], r ->
|
||||||
|
|
||||||
| ([], r) ->
|
|
||||||
(* Optimisation: Add extra chunk only if padding is needed *)
|
(* Optimisation: Add extra chunk only if padding is needed *)
|
||||||
if max_len_l > 0 then
|
if max_len_l > 0 then
|
||||||
let padding_chunk = mk_padding_chunk max_len_l in
|
let padding_chunk = mk_padding_chunk max_len_l in
|
||||||
List.map (fun line -> { chunks = padding_chunk :: line.chunks }) r
|
List.map (fun line -> { chunks = padding_chunk :: line.chunks }) r
|
||||||
else
|
else r
|
||||||
r
|
| hd_l :: tl_l, hd_r :: tl_r ->
|
||||||
|
|
||||||
| (hd_l :: tl_l, hd_r :: tl_r) ->
|
|
||||||
let left_len = line_len hd_l in
|
let left_len = line_len hd_l in
|
||||||
|
|
||||||
(* Optimisation: Combine chunks when left is already max len *)
|
(* Optimisation: Combine chunks when left is already max len *)
|
||||||
@ -73,24 +60,20 @@ let zip_lines (l: line list) (r: line list) =
|
|||||||
new_line :: zip tl_l tl_r
|
new_line :: zip tl_l tl_r
|
||||||
else
|
else
|
||||||
let padding_chunk = mk_padding_chunk (max_len_l - left_len) in
|
let padding_chunk = mk_padding_chunk (max_len_l - left_len) in
|
||||||
let new_line = { chunks = hd_l.chunks @ [padding_chunk] @ hd_r.chunks } in
|
let new_line =
|
||||||
|
{ chunks = hd_l.chunks @ [ padding_chunk ] @ hd_r.chunks }
|
||||||
|
in
|
||||||
new_line :: zip tl_l tl_r
|
new_line :: zip tl_l tl_r
|
||||||
in
|
in
|
||||||
|
|
||||||
zip l r
|
zip l r
|
||||||
|
|
||||||
let rec render_to_lines = function
|
let rec render_to_lines = function
|
||||||
| Empty ->
|
| Empty -> []
|
||||||
[]
|
| Str (styles, string) -> [ { chunks = [ { styles; string } ] } ]
|
||||||
| Str (styles, string) ->
|
| Vertical (top, bottom) -> render_to_lines top @ render_to_lines bottom
|
||||||
[{ chunks = [{styles; string}] }]
|
|
||||||
| Vertical (top, bottom) ->
|
|
||||||
render_to_lines top @ render_to_lines bottom
|
|
||||||
| Horizontal (left, right) ->
|
| Horizontal (left, right) ->
|
||||||
zip_lines (render_to_lines left) (render_to_lines right)
|
zip_lines (render_to_lines left) (render_to_lines right)
|
||||||
|
|
||||||
let render doc =
|
let render doc =
|
||||||
doc
|
doc |> render_to_lines |> List.map fmt_line |> String_extra.unlines
|
||||||
|> render_to_lines
|
|
||||||
|> List.map fmt_line
|
|
||||||
|> String_extra.unlines
|
|
||||||
|
@ -3,8 +3,7 @@ let unlines : string list -> string = String.concat "\n"
|
|||||||
let graphemes_len =
|
let graphemes_len =
|
||||||
Uuseg_string.fold_utf_8 `Grapheme_cluster (fun len _ -> len + 1) 0
|
Uuseg_string.fold_utf_8 `Grapheme_cluster (fun len _ -> len + 1) 0
|
||||||
|
|
||||||
let repeat_txt n txt =
|
let repeat_txt n txt = String.concat "" (List.init n (fun _ -> txt))
|
||||||
String.concat "" (List.init n (fun _ -> txt))
|
|
||||||
|
|
||||||
let fill_right (n : int) (s : string) : string =
|
let fill_right (n : int) (s : string) : string =
|
||||||
s ^ repeat_txt (n - graphemes_len s) " "
|
s ^ repeat_txt (n - graphemes_len s) " "
|
||||||
|
@ -5,7 +5,7 @@ let start repo path =
|
|||||||
match tree with
|
match tree with
|
||||||
| Fs.File path ->
|
| Fs.File path ->
|
||||||
Printf.printf "Given path '%s' is not a directory!" path;
|
Printf.printf "Given path '%s' is not a directory!" path;
|
||||||
exit 1;
|
exit 1
|
||||||
| Fs.Dir (dirname, files) ->
|
| Fs.Dir (dirname, files) ->
|
||||||
let initial_model = Model.initial_model ~repo ~dirname ~files in
|
let initial_model = Model.initial_model ~repo ~dirname ~files in
|
||||||
Minttea.start app ~initial_model
|
Minttea.start app ~initial_model
|
||||||
|
@ -1,5 +1,4 @@
|
|||||||
type code_tab =
|
type code_tab = {
|
||||||
{
|
|
||||||
(* Repository directory *)
|
(* Repository directory *)
|
||||||
dirname : string;
|
dirname : string;
|
||||||
(* Zipper of the repository code *)
|
(* Zipper of the repository code *)
|
||||||
@ -11,18 +10,11 @@ type tab =
|
|||||||
| Issues
|
| Issues
|
||||||
| PullRequests
|
| PullRequests
|
||||||
|
|
||||||
type t =
|
type t = {
|
||||||
{ repo: string ;
|
repo : string;
|
||||||
current_tab : tab;
|
current_tab : tab;
|
||||||
code_tab : code_tab;
|
code_tab : code_tab;
|
||||||
}
|
}
|
||||||
|
|
||||||
let initial_model ~repo ~dirname ~files =
|
let initial_model ~repo ~dirname ~files =
|
||||||
{
|
{ repo; current_tab = Code; code_tab = { dirname; fs = Fs.zip_it files } }
|
||||||
repo ;
|
|
||||||
current_tab = Code;
|
|
||||||
code_tab = {
|
|
||||||
dirname;
|
|
||||||
fs = Fs.zip_it files;
|
|
||||||
};
|
|
||||||
}
|
|
||||||
|
@ -2,33 +2,33 @@ open Minttea
|
|||||||
|
|
||||||
let move_fs move_fn (code_tab : Model.code_tab) =
|
let move_fs move_fn (code_tab : Model.code_tab) =
|
||||||
let fs = move_fn code_tab.fs in
|
let fs = move_fn code_tab.fs in
|
||||||
{ code_tab with fs = fs }
|
{ code_tab with fs }
|
||||||
|
|
||||||
let move_up (model: Model.t) = match model.current_tab with
|
let move_up (model : Model.t) =
|
||||||
| Code ->
|
match model.current_tab with
|
||||||
{ model with code_tab = move_fs Fs.go_up model.code_tab }
|
| Code -> { model with code_tab = move_fs Fs.go_up model.code_tab }
|
||||||
| Issues | PullRequests -> model
|
| Issues | PullRequests -> model
|
||||||
|
|
||||||
let move_down (model: Model.t) = match model.current_tab with
|
let move_down (model : Model.t) =
|
||||||
| Code ->
|
match model.current_tab with
|
||||||
{ model with code_tab = move_fs Fs.go_down model.code_tab }
|
| Code -> { model with code_tab = move_fs Fs.go_down model.code_tab }
|
||||||
| Issues | PullRequests -> model
|
| Issues | PullRequests -> model
|
||||||
|
|
||||||
let move_back (model: Model.t) = match model.current_tab with
|
let move_back (model : Model.t) =
|
||||||
| Code ->
|
match model.current_tab with
|
||||||
{ model with code_tab = move_fs Fs.go_back model.code_tab }
|
| Code -> { model with code_tab = move_fs Fs.go_back model.code_tab }
|
||||||
| Issues | PullRequests -> model
|
| Issues | PullRequests -> model
|
||||||
|
|
||||||
let move_next (model: Model.t) = match model.current_tab with
|
let move_next (model : Model.t) =
|
||||||
| Code ->
|
match model.current_tab with
|
||||||
{ model with code_tab = move_fs Fs.go_next model.code_tab }
|
| Code -> { model with code_tab = move_fs Fs.go_next model.code_tab }
|
||||||
| Issues | PullRequests -> model
|
| Issues | PullRequests -> model
|
||||||
|
|
||||||
let update event (model : Model.t) =
|
let update event (model : Model.t) =
|
||||||
match event with
|
match event with
|
||||||
(* if we press `q` or the escape key, we exit *)
|
(* if we press `q` or the escape key, we exit *)
|
||||||
| Event.KeyDown (Key "q" | Escape) -> (model, Command.Seq [Command.Exit_alt_screen; Command.Quit])
|
| Event.KeyDown (Key "q" | Escape) ->
|
||||||
|
(model, Command.Seq [ Command.Exit_alt_screen; Command.Quit ])
|
||||||
(* if we press a digit, we switch to the corresponding tab *)
|
(* if we press a digit, we switch to the corresponding tab *)
|
||||||
| Event.KeyDown (Key "1") ->
|
| Event.KeyDown (Key "1") ->
|
||||||
({ model with current_tab = Model.Code }, Command.Noop)
|
({ model with current_tab = Model.Code }, Command.Noop)
|
||||||
@ -36,16 +36,10 @@ let update event (model: Model.t) =
|
|||||||
({ model with current_tab = Model.Issues }, Command.Noop)
|
({ model with current_tab = Model.Issues }, Command.Noop)
|
||||||
| Event.KeyDown (Key "3") ->
|
| Event.KeyDown (Key "3") ->
|
||||||
({ model with current_tab = Model.PullRequests }, Command.Noop)
|
({ model with current_tab = Model.PullRequests }, Command.Noop)
|
||||||
|
|
||||||
(* directions/movements *)
|
(* directions/movements *)
|
||||||
| Event.KeyDown (Up | Key "k") ->
|
| Event.KeyDown (Up | Key "k") -> (move_up model, Command.Noop)
|
||||||
(move_up model, Command.Noop)
|
| Event.KeyDown (Down | Key "j") -> (move_down model, Command.Noop)
|
||||||
| Event.KeyDown (Down | Key "j") ->
|
| Event.KeyDown (Left | Key "h") -> (move_back model, Command.Noop)
|
||||||
(move_down model, Command.Noop)
|
| Event.KeyDown (Right | Key "l") -> (move_next model, Command.Noop)
|
||||||
| Event.KeyDown (Left | Key "h") ->
|
|
||||||
(move_back model, Command.Noop)
|
|
||||||
| Event.KeyDown (Right | Key "l") ->
|
|
||||||
(move_next model, Command.Noop)
|
|
||||||
|
|
||||||
(* otherwise, we do nothing *)
|
(* otherwise, we do nothing *)
|
||||||
| _ -> (model, Command.Noop)
|
| _ -> (model, Command.Noop)
|
||||||
|
131
lib/tui/view.ml
131
lib/tui/view.ml
@ -1,28 +1,16 @@
|
|||||||
let style_repo =
|
let style_repo = ANSITerminal.[ Bold; blue ]
|
||||||
ANSITerminal.([Bold; blue])
|
let style_selected = ANSITerminal.[ Bold; green ]
|
||||||
|
let style_directory = ANSITerminal.[ Bold; magenta ]
|
||||||
let style_selected =
|
|
||||||
ANSITerminal.([Bold; green])
|
|
||||||
|
|
||||||
let style_directory =
|
|
||||||
ANSITerminal.([Bold; magenta])
|
|
||||||
|
|
||||||
let tabs_section cur_tab =
|
let tabs_section cur_tab =
|
||||||
let open Pretty in
|
let open Pretty in
|
||||||
let p_tab tab txt =
|
let p_tab tab txt =
|
||||||
if cur_tab = tab
|
if cur_tab = tab then fmt style_selected txt else str txt
|
||||||
then fmt style_selected txt
|
|
||||||
else str txt
|
|
||||||
in
|
|
||||||
let sep = col
|
|
||||||
[
|
|
||||||
str " ";
|
|
||||||
str " ";
|
|
||||||
str "─";
|
|
||||||
]
|
|
||||||
in
|
in
|
||||||
|
let sep = col [ str " "; str " "; str "─" ] in
|
||||||
row
|
row
|
||||||
[ col
|
[
|
||||||
|
col
|
||||||
[
|
[
|
||||||
p_tab Model.Code "╭──────╮";
|
p_tab Model.Code "╭──────╮";
|
||||||
p_tab Model.Code "│ Code │";
|
p_tab Model.Code "│ Code │";
|
||||||
@ -48,20 +36,16 @@ let current_path_to_doc root_path parents =
|
|||||||
let nested_path =
|
let nested_path =
|
||||||
List.fold_left
|
List.fold_left
|
||||||
(fun acc cur -> Filename.concat acc cur)
|
(fun acc cur -> Filename.concat acc cur)
|
||||||
""
|
"" (List.rev parents)
|
||||||
(List.rev parents)
|
|
||||||
in
|
in
|
||||||
let full_path = Filename.concat root_path nested_path in
|
let full_path = Filename.concat root_path nested_path in
|
||||||
Pretty.fmt style_directory full_path
|
Pretty.fmt style_directory full_path
|
||||||
|
|
||||||
let current_level_to_doc (cursor : Fs.cursor) has_next =
|
let current_level_to_doc (cursor : Fs.cursor) has_next =
|
||||||
let open Pretty in
|
let open Pretty in
|
||||||
|
|
||||||
let files = Array.map Fs.file_name cursor.files in
|
let files = Array.map Fs.file_name cursor.files in
|
||||||
let max_name_len =
|
let max_name_len =
|
||||||
files
|
files |> Array.map String_extra.graphemes_len |> Array.fold_left max 0
|
||||||
|> Array.map String_extra.graphemes_len
|
|
||||||
|> Array.fold_left max 0
|
|
||||||
in
|
in
|
||||||
|
|
||||||
(* Add two spaces for padding before and end of the file name *)
|
(* Add two spaces for padding before and end of the file name *)
|
||||||
@ -76,37 +60,29 @@ let current_level_to_doc (cursor: Fs.cursor) has_next =
|
|||||||
let fmt_selected_line line =
|
let fmt_selected_line line =
|
||||||
"│ " ^ String_extra.fill_right max_name_len line ^ " ├"
|
"│ " ^ String_extra.fill_right max_name_len line ^ " ├"
|
||||||
in
|
in
|
||||||
let fmt_line line =
|
let fmt_line line = "│ " ^ String_extra.fill_right max_name_len line ^ " │" in
|
||||||
"│ " ^ String_extra.fill_right max_name_len line ^ " │"
|
let hi_pos = (2 * cursor.pos) + 1 in
|
||||||
in
|
|
||||||
let hi_pos = 2 * cursor.pos + 1 in
|
|
||||||
|
|
||||||
(* Combine *)
|
(* Combine *)
|
||||||
files
|
files
|
||||||
|> Array.to_list
|
|> Array.to_list
|
||||||
|> List.mapi (fun i line ->
|
|> List.mapi (fun i line ->
|
||||||
if i = cursor.pos && has_next
|
if i = cursor.pos && has_next then fmt_selected_line line
|
||||||
then fmt_selected_line line
|
else fmt_line line)
|
||||||
else fmt_line line
|
|
||||||
)
|
|
||||||
|> List_extra.in_between ~sep:mid
|
|> List_extra.in_between ~sep:mid
|
||||||
|> (fun lines -> [ top ] @ lines @ [ bot ])
|
|> (fun lines -> [ top ] @ lines @ [ bot ])
|
||||||
|> List.mapi (fun i s ->
|
|> List.mapi (fun i s ->
|
||||||
if i = hi_pos - 1 || i = hi_pos || i = hi_pos + 1
|
if i = hi_pos - 1 || i = hi_pos || i = hi_pos + 1 then
|
||||||
then fmt style_selected s
|
fmt style_selected s
|
||||||
else str s
|
else str s)
|
||||||
)
|
|
||||||
|> col
|
|> col
|
||||||
|
|
||||||
let children_to_doc ~prev_total ~pos children =
|
let children_to_doc ~prev_total ~pos children =
|
||||||
let open Pretty in
|
let open Pretty in
|
||||||
|
|
||||||
(* This array is guaranteed to be non-empty at this point *)
|
(* This array is guaranteed to be non-empty at this point *)
|
||||||
let files = Array.map Fs.file_name children in
|
let files = Array.map Fs.file_name children in
|
||||||
let max_name_len =
|
let max_name_len =
|
||||||
files
|
files |> Array.map String_extra.graphemes_len |> Array.fold_left max 0
|
||||||
|> Array.map String_extra.graphemes_len
|
|
||||||
|> Array.fold_left max 0
|
|
||||||
in
|
in
|
||||||
|
|
||||||
(* Add two spaces for padding before and end of the file name *)
|
(* Add two spaces for padding before and end of the file name *)
|
||||||
@ -118,17 +94,12 @@ let children_to_doc ~prev_total ~pos children =
|
|||||||
let bot = " ╰" ^ String_extra.repeat_txt (max_len - 2) "─" ^ "╯" in
|
let bot = " ╰" ^ String_extra.repeat_txt (max_len - 2) "─" ^ "╯" in
|
||||||
|
|
||||||
(* Connector arrow *)
|
(* Connector arrow *)
|
||||||
let prev_rows_count = 2 * prev_total + 1 in
|
let prev_rows_count = (2 * prev_total) + 1 in
|
||||||
let connect_pos = 2 * pos + 1 in
|
let connect_pos = (2 * pos) + 1 in
|
||||||
let connector_doc =
|
let connector_doc =
|
||||||
List_extra.generate
|
List_extra.generate prev_rows_count (fun i ->
|
||||||
prev_rows_count
|
|
||||||
(fun i ->
|
|
||||||
let is_current_pos = i = connect_pos in
|
let is_current_pos = i = connect_pos in
|
||||||
if is_current_pos
|
if is_current_pos then str "─" else str " ")
|
||||||
then str "─"
|
|
||||||
else str " "
|
|
||||||
)
|
|
||||||
|> col
|
|> col
|
||||||
in
|
in
|
||||||
|
|
||||||
@ -138,14 +109,9 @@ let children_to_doc ~prev_total ~pos children =
|
|||||||
let is_last_pos = i = Array.length children - 1 in
|
let is_last_pos = i = Array.length children - 1 in
|
||||||
let has_more_than_one = Array.length children > 1 in
|
let has_more_than_one = Array.length children > 1 in
|
||||||
let prefix =
|
let prefix =
|
||||||
if is_first_pos then
|
if is_first_pos then if has_more_than_one then "┬" else "─"
|
||||||
(if has_more_than_one
|
else if is_last_pos then "└"
|
||||||
then "┬"
|
else "├"
|
||||||
else "─")
|
|
||||||
else if is_last_pos then
|
|
||||||
"└"
|
|
||||||
else
|
|
||||||
"├"
|
|
||||||
in
|
in
|
||||||
prefix ^ "─┤ " ^ String_extra.fill_right max_name_len line ^ " │"
|
prefix ^ "─┤ " ^ String_extra.fill_right max_name_len line ^ " │"
|
||||||
in
|
in
|
||||||
@ -159,12 +125,9 @@ let children_to_doc ~prev_total ~pos children =
|
|||||||
|> (fun lines -> [ top ] @ lines @ [ bot ])
|
|> (fun lines -> [ top ] @ lines @ [ bot ])
|
||||||
|> (fun lines ->
|
|> (fun lines ->
|
||||||
let pad_before =
|
let pad_before =
|
||||||
List_extra.generate
|
List_extra.generate (max (connect_pos - 1) 0) (fun _ -> "")
|
||||||
(max (connect_pos - 1) 0)
|
|
||||||
(fun _ -> "")
|
|
||||||
in
|
in
|
||||||
pad_before @ lines
|
pad_before @ lines)
|
||||||
)
|
|
||||||
|> List.map str
|
|> List.map str
|
||||||
|> col
|
|> col
|
||||||
in
|
in
|
||||||
@ -184,27 +147,23 @@ let next_level_to_doc ~prev_total ~pos (selected_file: Fs.tree) =
|
|||||||
let fs_doc (fs : Fs.zipper) =
|
let fs_doc (fs : Fs.zipper) =
|
||||||
let current = fs.current in
|
let current = fs.current in
|
||||||
let next_level_doc =
|
let next_level_doc =
|
||||||
Option.bind
|
Option.bind (Fs.file_at current)
|
||||||
(Fs.file_at current)
|
(next_level_to_doc
|
||||||
(next_level_to_doc ~prev_total:(Array.length current.files) ~pos:current.pos)
|
~prev_total:(Array.length current.files)
|
||||||
|
~pos:current.pos)
|
||||||
|
in
|
||||||
|
let current_level_doc =
|
||||||
|
current_level_to_doc current (Option.is_some next_level_doc)
|
||||||
in
|
in
|
||||||
let current_level_doc = current_level_to_doc current (Option.is_some next_level_doc) in
|
|
||||||
match next_level_doc with
|
match next_level_doc with
|
||||||
| None ->
|
| None -> current_level_doc
|
||||||
current_level_doc
|
| Some next_level_doc -> Pretty.row [ current_level_doc; next_level_doc ]
|
||||||
| Some next_level_doc ->
|
|
||||||
Pretty.row [ current_level_doc; next_level_doc]
|
|
||||||
|
|
||||||
let code_section (code_tab : Model.code_tab) =
|
let code_section (code_tab : Model.code_tab) =
|
||||||
let current_path_doc = current_path_to_doc
|
let current_path_doc =
|
||||||
code_tab.dirname
|
current_path_to_doc code_tab.dirname (Fs.zipper_parents code_tab.fs)
|
||||||
(Fs.zipper_parents code_tab.fs)
|
|
||||||
in
|
in
|
||||||
Pretty.col
|
Pretty.col [ current_path_doc; fs_doc code_tab.fs ]
|
||||||
[
|
|
||||||
current_path_doc;
|
|
||||||
fs_doc code_tab.fs;
|
|
||||||
]
|
|
||||||
|
|
||||||
let tab_content_section (model : Model.t) =
|
let tab_content_section (model : Model.t) =
|
||||||
match model.current_tab with
|
match model.current_tab with
|
||||||
@ -213,21 +172,11 @@ let tab_content_section (model: Model.t) =
|
|||||||
|
|
||||||
let to_doc (model : Model.t) =
|
let to_doc (model : Model.t) =
|
||||||
let open Pretty in
|
let open Pretty in
|
||||||
|
|
||||||
let empty = str "" in
|
let empty = str "" in
|
||||||
let repo = fmt style_repo model.repo in
|
let repo = fmt style_repo model.repo in
|
||||||
let tabs = tabs_section model.current_tab in
|
let tabs = tabs_section model.current_tab in
|
||||||
let content = tab_content_section model in
|
let content = tab_content_section model in
|
||||||
|
|
||||||
col
|
col [ repo; empty; tabs; content; empty ]
|
||||||
[
|
|
||||||
repo;
|
|
||||||
empty;
|
|
||||||
|
|
||||||
tabs;
|
let view (model : Model.t) = model |> to_doc |> Pretty.render
|
||||||
content;
|
|
||||||
empty;
|
|
||||||
]
|
|
||||||
|
|
||||||
let view (model: Model.t) =
|
|
||||||
model |> to_doc |> Pretty.render
|
|
||||||
|
Loading…
Reference in New Issue
Block a user