path: root/lib/editorBuffer.ml

open Base
open Stdio
open Zipper
open Util

type kind = File of string | No_name | Scratch
type error = No_such_file | Other

type buffer = {
  kind : kind;
  content : (char zipper zipper, error) Result.t;
  rendered : char Sequence.t zipper;
}

type t = buffer

let empty =
  {
    kind = No_name;
    content = empty |> push empty |> Result.return;
    rendered = push Sequence.empty empty;
  }

let render =
  let open Sequence in
  let tabsize = 8 in
  let f i = function
    | '\t' ->
        let width = tabsize - (i % tabsize) in
        (i + width, take (repeat '.') width)
    | c -> (i + 1, singleton c)
  in
  folding_map ~init:0 ~f &> join

let cursor ?(rendered = true) b =
  match b.content with
  | Error _ -> (0, 0)
  | Ok c ->
      let hlen z =
        if rendered then
          Sequence.(length (before z |> to_list_rev |> of_list |> render))
        else left_length z
      in
      (left_length c, apply_focus_or ~default:0 hlen c)

module Action = struct
  let on_content f b = { b with content = Result.map ~f b.content }
  let on_rendered f b = { b with rendered = f b.rendered }

  (* let on_content_stored ?(register = '"') ?(append = false) f b = ... *)

  let update_render_at_cursor b =
    match b.content with
    | Error _ -> b
    | Ok c ->
        let l = apply_focus_or ~default:Sequence.empty (to_seq &> render) c in
        { b with rendered = swap_focus l b.rendered }

  let move_up ?(n = 1) =
    let change_content =
      on_content (fun z ->
          let col = apply_focus_or ~default:0 left_length z in
          Fn.apply_n_times ~n left z |> map_focus (goto col))
    and change_rendered = on_rendered (Fn.apply_n_times ~n left) in
    change_content &> change_rendered

  let move_down ?(n = 1) =
    let change_content =
      on_content (fun z ->
          let col = apply_focus_or ~default:0 left_length z in
          Fn.apply_n_times ~n right z |> map_focus (goto col))
    and change_rendered = on_rendered (Fn.apply_n_times ~n right) in
    change_content &> change_rendered

  let move_left, move_right =
    let horizontal f ?(n = 1) =
      let change_content = map_focus (Fn.apply_n_times ~n f) |> on_content in
      change_content &> update_render_at_cursor
    in
    (horizontal left, horizontal right)

  let bol = map_focus far_left |> on_content
  let eol = map_focus far_right |> on_content

  let bof =
    let change_content = far_left |> on_content
    and change_rendered = far_left |> on_rendered in
    change_content &> change_rendered

  let eof =
    let change_content = far_right |> on_content
    and change_rendered = far_right |> on_rendered in
    change_content &> change_rendered

  let insert k =
    let change_content = map_focus (push_before k) |> on_content in
    change_content &> update_render_at_cursor

  (* let replace k = () *)

  let join_lines ?(n = 2) =
    let change_content =
      let join_2_lines z =
        if right_length z < 2 then z
        else
          let to_join = right z |> focus_or ~default:Zipper.empty in
          map_focus (join ~z2:to_join) z |> pop_after
      in
      Fn.apply_n_times ~n:(n - 1) join_2_lines |> on_content
    and change_rendered = pop_after ~n:(n - 1) |> on_rendered in
    change_content &> change_rendered &> update_render_at_cursor

  let delete_after ?(cross_lines = false) ~n b =
    let lines_to_delete =
      match b.content with
      | Error _ -> 0
      | Ok z -> (
          match Sequence.next (after z) with
          | None -> 0
          | Some (h, t) ->
              let init = right_length h
              and f acc z =
                let acc' = acc + length z + 1 in
                (acc', acc')
              in
              Sequence.shift_right (Sequence.folding_map t ~init ~f) init
              |> Sequence.findi ~f:(fun _ a -> n <= a)
              |> Option.map ~f:fst
              |> Option.value ~default:(Sequence.length t))
    in
    let change_content =
      let delete_1_after z =
        let line = focus_or ~default:Zipper.empty z in
        if cross_lines && is_far_right line && not (is_far_right z) then
          let to_join = right z |> focus_or ~default:Zipper.empty in
          map_focus (join ~z2:to_join) z |> pop_after
        else map_focus pop z
      in
      Fn.apply_n_times ~n delete_1_after |> on_content
    and change_rendered =
      if cross_lines then pop_after ~n:lines_to_delete |> on_rendered else Fn.id
    in
    b |> change_content |> change_rendered |> update_render_at_cursor

  let delete_before ?(cross_lines = false) ~n b =
    let lines_to_delete =
      match b.content with
      | Error _ -> 0
      | Ok z ->
          let init = apply_focus_or ~default:0 left_length z
          and f acc z =
            let acc' = acc + length z + 1 in
            (acc', acc')
          in
          Sequence.shift_right (Sequence.folding_map (before z) ~init ~f) init
          |> Sequence.findi ~f:(fun _ a -> n <= a)
          |> Option.map ~f:fst
          |> Option.value ~default:(left_length z)
    in
    let change_content =
      let delete_1_before z =
        let line = focus_or ~default:Zipper.empty z in
        if cross_lines && is_far_left line && not (is_far_left z) then
          left z |> map_focus (join ~z2:line) |> pop_after
        else map_focus pop_before z
      in
      Fn.apply_n_times ~n delete_1_before |> on_content
    and change_rendered =
      if cross_lines then pop_before ~n:lines_to_delete |> on_rendered
      else Fn.id
    in
    b |> change_content |> change_rendered |> update_render_at_cursor

  let delete_to_eol =
    map_focus (split &> fst) |> on_content &> update_render_at_cursor

  let delete_to_bol =
    map_focus (split &> snd) |> on_content &> update_render_at_cursor

  let delete_lines ~n =
    let change_content = pop ~n |> on_content
    and change_rendered = pop ~n |> on_rendered in
    change_content &> change_rendered

  let delete_lines_before ~n =
    let change_content = pop_before ~n |> on_content
    and change_rendered = pop_before ~n |> on_rendered in
    change_content &> change_rendered

  let newline =
    let change_content =
      let aux z =
        let default = (Zipper.empty, Zipper.empty) in
        let l1, l2 = apply_focus_or ~default split z in
        push_before l1 z |> swap_focus l2
      in
      on_content aux
    and change_rendered b =
      match b.content with
      | Error _ -> b
      | Ok c -> (
          match Sequence.next (before c) with
          | None -> failwith "newline > change_rendered: unreachable"
          | Some (h, _) ->
              { b with rendered = push_before (to_seq h |> render) b.rendered })
    in
    change_content &> change_rendered &> update_render_at_cursor

  (* let save_history_to ?(clear = true) r = () *)
end

let from_file f =
  let lines =
    let line_to_seq l = String.to_list l |> Sequence.of_list in
    try
      let fd = Unix.(openfile f [ O_RDONLY ] 0o640) in
      let ic = Unix.in_channel_of_descr fd in
      let lines = In_channel.input_lines ic in
      In_channel.close ic;
      Sequence.(of_list lines |> map ~f:line_to_seq)
    with Unix.Unix_error (ENOENT, _, _) -> Sequence.empty
  in
  let rendered = Sequence.map ~f:render lines |> of_seq in
  let content = Sequence.map ~f:of_seq lines |> of_seq in
  { kind = File f; content = Ok content; rendered }

let unrendered_view x y h w b =
  match b.content with
  | Error _ -> Sequence.empty
  | Ok z ->
      let cx, _ = cursor b in
      context ~l:(cx - x) ~r:(x + h - cx) z
      |> to_seq
      |> Sequence.map ~f:(window ~from:y ~len:w)

let rendered_view x y h w b =
  let window from len seq = Sequence.(take (drop_eagerly seq from) len) in
  let cx, _ = cursor b in
  context ~l:(cx - x) ~r:(x + h - cx) b.rendered
  |> to_seq
  |> Sequence.map ~f:(window y w)