path: root/lib/grep.ml

let execution_directory =
  Sys.getenv_opt "STITCH_DIRECTORY" |> Option.value ~default:"/anywhere"


let grep_cmd = Sys.getenv_opt "STITCH_GREP_CMD" |> Option.value ~default:"grep"

let tag_pattern =
  Sys.getenv_opt "STITCH_TAG_PATTERN" |> Option.value ~default:"\\:[a-z-]+\\:"


let headline_pattern_regexp =
  Sys.getenv_opt "STITCH_HEADLINE_PATTERN_REGEXP" |> Option.value ~default:"^\\* "


let headline_pattern =
  Sys.getenv_opt "STITCH_HEADLINE_PATTERN" |> Option.value ~default:"* "


let todo_pattern = Sys.getenv_opt "STITCH_TODO" |> Option.value ~default:"* TODO"

let todo_pattern_regexp =
  Sys.getenv_opt "STITCH_TODO_REGEXP" |> Option.value ~default:"\\* TODO"


let done_pattern = Sys.getenv_opt "STITCH_DONE" |> Option.value ~default:"* DONE"

let done_pattern_regexp =
  Sys.getenv_opt "STITCH_DONE_REGEXP" |> Option.value ~default:"\\* DONE"


(* Utils *)

let run_calls calls =
  let open Shexp_process in
  let open Shexp_process.Infix in
  eval (chdir execution_directory (calls |- read_all))


let get_padding_arr arr =
  Array.fold_left (fun n (file_name, _) -> Int.max n (String.length file_name)) 0 arr


let get_padding_list list =
  List.fold_left (fun n (file_name, _) -> Int.max n (String.length file_name)) 0 list


let pad str n =
  let padding = n - String.length str in
  String.concat "" [ str; String.make padding ' ' ]


exception Not_A_Tuple of string * string

(* todo parsing *)
let done_get_args = [ grep_cmd; done_pattern_regexp; "-H"; "-r"; "-n"; "--no-messages" ]

let get_done () =
  let open Shexp_process in
  let open Shexp_process.Infix in
  try run_calls (call done_get_args |- call [ "sort"; "-n"; "-r" ]) with
  | _ -> ""


let todo_get_args = [ grep_cmd; todo_pattern_regexp; "-H"; "-r"; "-n"; "--no-messages" ]

let get_todos () =
  let open Shexp_process in
  let open Shexp_process.Infix in
  try run_calls (call todo_get_args |- call [ "sort"; "-n"; "-r" ]) with
  | _ -> ""


let parse_todo_files files =
  List.concat
  @@ List.mapi
       (fun file_number ((file_name : string), content) ->
         let content = String.split_on_char '\n' content in
         List.mapi
           (fun line_number line -> file_name, line_number, line, file_number)
           content)
       files


let parse_todo_string s =
  String.split_on_char '\n' s
  |> List.filter_map (fun message ->
    if String.equal message ""
    then None
    else (
      let split = Str.bounded_split (Str.regexp ":[0-9]+:") message 2 in
      match split with
      (* file, line, content *)
      | [ file_name; content ] -> Some (file_name, content)
      | _ -> raise (Not_A_Tuple (String.concat " SPLIT " split, message))))


let pretty_format_todo ~hide_file_name parsed_headlines =
  let padding = get_padding_list parsed_headlines in
  List.map
    (fun (file_name, content) ->
      if not hide_file_name
      then String.concat " " [ pad file_name padding; content ]
      else content)
    parsed_headlines


let get_tagged_done tag () =
  let open Shexp_process in
  let open Shexp_process.Infix in
  try
    eval
      (chdir
         execution_directory
         (call done_get_args
          |- call [ grep_cmd; "--no-messages"; "-E"; tag ]
          |- call [ "sort"; "-n"; "-r" ]
          |- read_all))
  with
  | _ -> ""


let get_tagged_todo tag () =
  let open Shexp_process in
  let open Shexp_process.Infix in
  try
    eval
      (chdir
         execution_directory
         (call todo_get_args
          |- call [ grep_cmd; "--no-messages"; "-E"; tag ]
          |- call [ "sort"; "-n"; "-r" ]
          |- read_all))
  with
  | _ -> ""


let toggle_done file_name =
  let open Shexp_process in
  run_calls
    (call
       [ "sed"; "-i"; "s/" ^ todo_pattern_regexp ^ "/" ^ done_pattern ^ "/g"; file_name ])


let toggle_todo file_name =
  let open Shexp_process in
  run_calls
    (call
       [ "sed"; "-i"; "s/" ^ done_pattern_regexp ^ "/" ^ todo_pattern ^ "/g"; file_name ])


(* Headline parsing *)
let headline_pattern_length = String.length headline_pattern

let find_sort_modification () =
  let open Shexp_process in
  let open Shexp_process.Infix in
  call [ "find"; "."; "-printf"; "%Ts/%f\\n" ]
  |- call [ "sort"; "-n" ]
  |- call [ "cut"; "-c12-" ]


let find_sort_name () =
  let open Shexp_process in
  call [ "ls" ]


let run_print ~dir args =
  let open Shexp_process in
  let open Shexp_process.Infix in
  eval (chdir dir (call args |- read_all))


let filter_todos_args = [ grep_cmd; todo_pattern_regexp; "--no-messages"; "-v" ]
let filter_done_args = [ grep_cmd; done_pattern_regexp; "--no-messages"; "-v" ]

let headline_args =
  [ "xargs"; grep_cmd; headline_pattern_regexp; "-H"; "-r"; "-n"; "--no-messages" ]


let get_headlines () =
  let open Shexp_process in
  let open Shexp_process.Infix in
  try
    eval
      (chdir
         execution_directory
         (find_sort_name ()
          |- call headline_args
          |- call filter_todos_args
          |- call filter_done_args
          |- call [ "sort"; "-n"; "-r" ]
          |- read_all))
  with
  | _ -> ""


let get_tagged_headlines tag () =
  let open Shexp_process in
  let open Shexp_process.Infix in
  try
    eval
      (chdir
         execution_directory
         (find_sort_name ()
          |- call headline_args
          |- call [ grep_cmd; "--no-messages"; "-E"; tag ]
          |- call filter_todos_args
          |- call filter_done_args
          |- call [ "sort"; "-n"; "-r" ]
          |- read_all))
  with
  | _ -> ""


let get_tags () =
  let open Shexp_process in
  let open Shexp_process.Infix in
  eval
    (chdir
       execution_directory
       (call headline_args |- call [ grep_cmd; "-E"; tag_pattern; "-o" ] |- read_all))


(** Returns a tuple of file name and Content *)
let parse_headlines s =
  String.split_on_char '\n' s
  (* Testing in utop it seems like there is maybe a bug with bounded_split, 1 doesn't work for ':'. Therefore using a slower implementation. *)
  |> List.filter_map (fun message ->
    if String.equal message ""
    then None
    else (
      let split = Str.bounded_split (Str.regexp ":[0-9]+:") message 2 in
      match split with
      (* file, line, content *)
      | [ file_name; content ] -> Some (file_name, content)
      | _ -> raise (Not_A_Tuple (String.concat " SPLIT " split, message))))
  |> Array.of_list


(** Turns "2024-03-05.org:* Hello world" into "2024-03-05    | * Hello world" *)
let pretty_format ~hide_file_name parsed_headlines =
  let padding = get_padding_arr parsed_headlines in
  Array.map
    (fun (file_name, content) ->
      if not hide_file_name
      then String.concat " " [ pad file_name padding; content ]
      else content)
    parsed_headlines


(** Full body parsing *)

let read_whole_file filename =
  (* open_in_bin works correctly on Unix and Windows *)
  try
    let ch = open_in_bin filename in
    let s = really_input_string ch (in_channel_length ch) in
    close_in ch;
    s
  with
  | _ -> ""


let get_full_file_content_content file =
  file, read_whole_file (execution_directory ^ "/" ^ file)


let parse_full_content files =
  List.concat
  @@ List.mapi
       (fun file_number ((file_name : string), content) ->
         let content = String.split_on_char '\n' content in
         List.mapi
           (fun line_number line -> file_name, line_number, line, file_number)
           content)
       files


let get_file_names tag =
  try
    let cmd =
      let open Shexp_process in
      let open Shexp_process.Infix in
      find_sort_name ()
      |- call [ "xargs"; grep_cmd; "-H"; "-l"; "-E"; tag ]
      |- call [ "sort"; "-n"; "-r" ]
      |- read_all
    in
    Shexp_process.eval (Shexp_process.chdir execution_directory cmd)
    |> String.split_on_char '\n'
    |> List.filter (fun s -> not (String.equal "" s))
  with
  | _ -> []


type display_type =
  | Bold of string
  | Normal of string

let display_type_line = function
  | Bold s -> s
  | Normal s -> s


let pretty_print_parsed_content parsed_files =
  let padding = String.make headline_pattern_length ' ' in
  List.concat_map
    (fun (file_name, line_number, line_content, file_number) ->
      if line_number == 0
      then
        [ file_number, Normal ("--------- " ^ file_name); file_number, Bold line_content ]
      else [ file_number, Normal (padding ^ line_content) ])
    parsed_files