Format OCaml code

This commit is contained in:
Dmitrii Kovanikov 2024-03-23 10:26:12 +00:00
parent 492f54e246
commit 096f32b9bd
16 changed files with 195 additions and 294 deletions

View File

@ -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

View File

@ -1,6 +1,4 @@
(executable (executable
(public_name github_tui) (public_name github_tui)
(name main) (name main)
(libraries (libraries github_tui))
github_tui
))

View File

@ -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

View File

@ -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
)
)

View File

@ -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 }

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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) " "

View File

@ -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

View File

@ -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;
};
}

View File

@ -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)

View File

@ -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