path: root/lib/editor.ml

open Base
module Buffer = EditorBuffer
open Util

type mode = Normal | Insert
type cursor = int * int

type editor = {
  term : Terminal.state;
  mode : mode;
  offset : int * int;
  cursor : cursor;
  buffer : Buffer.t option;
  pending : Key.t Sequence.t;
  i_pending : Command.t Sequence.t;
  n_pending : Command.t Sequence.t;
}

type t = editor

let init (c : Config.t) : editor =
  {
    term = Terminal.init ();
    mode = Normal;
    offset = (0, 0);
    cursor = (1, 1);
    buffer = List.hd c.files |> Option.map ~f:Buffer.from_file;
    pending = Key.stream;
    i_pending = Command.i_stream;
    n_pending = Command.n_stream;
  }

type 'a action = t -> 'a * t

module Action = struct
  let run ~editor action = action () editor
  let eval ~editor action = run ~editor action |> fst
  let exec ~editor action = run ~editor action |> snd

  include Applicative.Make (struct
    type 'a t = 'a action

    let return a s = (a, s)

    let apply f a e =
      let f, e' = f e in
      let x, e'' = a e' in
      (f x, e'')

    let map = `Define_using_apply
  end)

  include Monad.Make (struct
    type 'a t = 'a action

    let return x s = (x, s)

    let bind a ~f x =
      let y, a' = a x in
      f y a'

    let map = `Define_using_bind
  end)

  let get e = (e, e)
  let put e _ = ((), e)
  let modify ~f e = ((), f e)

  let update_cursor =
    let aux e =
      let dx, dy = e.offset and rs, cs = e.term.size in
      match Option.map ~f:Buffer.cursor e.buffer with
      | None -> { e with cursor = (1, 1); offset = (0, 0) }
      | Some (cx, cy) ->
          let dx' = Int.clamp_exn ~min:(cx - rs + 1) ~max:cx dx
          and dy' = Int.clamp_exn ~min:(cy - cs + 1) ~max:cy dy in
          { e with cursor = (cx - dx' + 1, cy - dy' + 1); offset = (dx', dy') }
    in
    modify ~f:aux

  let get_mode s = (s.mode, s)
  let set_mode m s = ((), { s with mode = m })
  let get_focused_buffer e = (e.buffer, e)
  let set_focused_buffer b e = ((), { e with buffer = Some b })

  let on_focused_buffer f =
    let f e = { e with buffer = Option.map ~f e.buffer } in
    modify ~f *> update_cursor

  let on_focused_buffer_or_new f =
    (get_focused_buffer
    >>| Option.value ~default:Buffer.empty
    >>| f >>= set_focused_buffer)
    *> update_cursor

  let render =
    let welcome (r, c) =
      let open Text in
      let hfill = ' ' and vfill = Sequence.empty in
      "Welcome to the sand editor!" |> String.to_list |> Sequence.of_list
      |> center ~fill:hfill c |> Sequence.singleton |> center ~fill:vfill r
    in
    let aux e =
      let x, y = e.offset
      and ((r, c) as size) = e.term.size
      and fill = Sequence.singleton '~' in
      let view =
        Option.(
          e.buffer >>| Buffer.view x y r c
          |> value ~default:(welcome size)
          |> Text.extend ~fill r)
      in
      Terminal.redraw view e.cursor
    in
    get >>| aux

  (* TODO: save logic *)
  let quit n = Stdlib.exit n
  let noop = return ()
end

let move ?(up = 0) ?(down = 0) ?(left = 0) ?(right = 0) (x, y) =
  (x + down - up, y + right - left)

let move_to ?x ?y (sx, sy) = Option.(value x ~default:sx, value y ~default:sy)

(* let get_next_command s = *)
(*   match Sequence.next s.pending with *)
(*   | None -> (None, s) *)
(*   | Some (h, t) -> (Some h, { s with pending = t }) *)

(* let handle_insert_key = *)
(*   let open Action in *)
(*   let open Key in *)
(*   function *)
(*   | Arrow_down -> Buffer.Action.down |> on_focused_buffer *)
(*   | Arrow_left -> Buffer.Action.left |> on_focused_buffer *)
(*   | Arrow_right -> Buffer.Action.right |> on_focused_buffer *)
(*   | Arrow_up -> Buffer.Action.up |> on_focused_buffer *)
(*   | Backspace -> Buffer.Action.delete_before |> on_focused_buffer *)
(*   | Ctrl 'Q' -> quit 0 *)
(*   | Delete -> Buffer.Action.delete_after |> on_focused_buffer *)
(*   | Enter -> Buffer.Action.newline |> on_focused_buffer *)
(*   | Esc -> (Buffer.Action.left |> on_focused_buffer) *> set_mode Normal *)
(*   | Key k -> Buffer.Action.insert k |> on_focused_buffer *)
(*   | _ -> noop *)

(* let handle_normal_key = *)
(*   let open Action in *)
(*   let open Key in *)
(*   function *)
(*   | Arrow_down | Key 'j' -> Buffer.Action.down |> on_focused_buffer *)
(*   | Arrow_left | Backspace | Key 'h' -> Buffer.Action.left |> on_focused_buffer *)
(*   | Arrow_right | Key ' ' | Key 'l' -> Buffer.Action.right |> on_focused_buffer *)
(*   | Arrow_up | Key 'k' -> Buffer.Action.up |> on_focused_buffer *)
(*   | Ctrl 'Q' -> quit 0 *)
(*   | Key '0' -> Buffer.Action.bol |> on_focused_buffer_or_new *)
(*   | Key 'A' -> *)
(*       (Buffer.Action.eol |> on_focused_buffer_or_new) *> set_mode Insert *)
(*   | Key 'a' -> *)
(*       (Buffer.Action.right |> on_focused_buffer_or_new) *> set_mode Insert *)
(*   | Key 'G' -> Buffer.Action.eof |> on_focused_buffer_or_new *)
(*   | Key 'I' -> *)
(*       noop *)
(*       (1* (Buffer.Action.bol |> on_focused_buffer_or_new) *> set_mode Insert *1) *)
(*   | Key 'i' -> (Fn.id |> on_focused_buffer_or_new) *> set_mode Insert *)
(*   | Key 's' -> *)
(*       (Buffer.Action.delete_after |> on_focused_buffer_or_new) *)
(*       *> set_mode Insert *)
(*   | Key 'x' -> Buffer.Action.delete_after |> on_focused_buffer_or_new *)
(*   | Key 'X' -> Buffer.Action.delete_before |> on_focused_buffer_or_new *)
(*   | Key '$' -> Buffer.Action.eol |> on_focused_buffer_or_new *)
(*   | _ -> noop *)

(* let handle_next_command = *)
(*   let f m = function *)
(*     | None -> Action.return () *)
(*     | Some k -> ( *)
(*         match m with *)
(*         | Insert -> handle_insert_key k *)
(*         | Normal -> handle_normal_key k) *)
(*   in *)
(*   Action.(map2 ~f get_mode get_next_command |> join) *)

let handle_insert_command =
  let open Command in
  let open Action in
  function
  | Simple Arrow_down -> Buffer.Action.move_down |> on_focused_buffer
  | Simple Arrow_left -> Buffer.Action.move_left |> on_focused_buffer
  | Simple Arrow_right -> Buffer.Action.move_right |> on_focused_buffer
  | Simple Arrow_up -> Buffer.Action.move_up |> on_focused_buffer
  | Simple Backspace ->
      Buffer.Action.delete_before ~cross_lines:true ~n:1 |> on_focused_buffer
  | Simple (Ctrl 'Q') -> quit 0
  | Simple Delete ->
      Buffer.Action.delete_after ~cross_lines:true ~n:1 |> on_focused_buffer
  | Simple Enter -> Buffer.Action.newline |> on_focused_buffer
  | Simple Esc ->
      (Buffer.Action.move_left |> on_focused_buffer) *> set_mode Normal
  | Type k -> Buffer.Action.insert k |> on_focused_buffer
  | _ -> noop

let handle_normal_command =
  let open Command in
  let open Action in
  function
  (* Movements *)
  | Chord (_, n, Noop, _, Down) ->
      Buffer.Action.move_down ?n |> on_focused_buffer
  | Chord (_, n, Noop, _, Left) ->
      Buffer.Action.move_left ?n |> on_focused_buffer
  | Chord (_, n, Noop, _, Right) ->
      Buffer.Action.move_right ?n |> on_focused_buffer
  | Chord (_, n, Noop, _, Up) -> Buffer.Action.move_up ?n |> on_focused_buffer
  | Simple (Ctrl 'Q') -> quit 0
  (* | Key '0' -> Buffer.Action.bol |> on_focused_buffer_or_new *)
  | Simple (Key 'A') ->
      (Buffer.Action.eol |> on_focused_buffer_or_new) *> set_mode Insert
  | Simple (Key 'a') ->
      (Buffer.Action.move_right |> on_focused_buffer_or_new) *> set_mode Insert
  (* | Key 'G' -> Buffer.Action.eof |> on_focused_buffer_or_new *)
  (* | Key 'I' -> noop *)
  | Simple (Key 'i') -> (Fn.id |> on_focused_buffer_or_new) *> set_mode Insert
  (* | Key 's' -> *)
  (*     (Buffer.Action.delete_after |> on_focused_buffer_or_new) *)
  (* *> set_mode Insert *)
  (* | Key 'x' | Delete -> Buffer.Action.delete_after |> on_focused_buffer_or_new *)
  (* | Key 'X' -> Buffer.Action.delete_before |> on_focused_buffer_or_new *)
  (* | Key '$' -> Buffer.Action.eol |> on_focused_buffer_or_new *)
  (* Change *)
  | Shortcut (_, n, Change) ->
      let n = Option.value ~default:1 n - 1 in
      (Buffer.Action.(
         delete_to_eol &> move_down &> delete_lines ~n &> move_up &> eol)
      |> on_focused_buffer_or_new)
      *> set_mode Insert
  | Chord (_, n1, Change, n2, Line) ->
      let n = Option.((value ~default:1 n1 * value ~default:1 n2) - 1) in
      (Buffer.Action.(delete_lines ~n &> bol &> delete_to_eol)
      |> on_focused_buffer_or_new)
      *> set_mode Insert
  | Chord (_, n1, Change, n2, Down) ->
      let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
      (Buffer.Action.(delete_lines ~n &> bol &> delete_to_eol)
      |> on_focused_buffer_or_new)
      *> set_mode Insert
  | Chord (_, n1, Change, n2, Left) ->
      let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
      (Buffer.Action.delete_before ~n |> on_focused_buffer_or_new)
      *> set_mode Insert
  | Chord (_, n1, Change, n2, Right) ->
      let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
      (Buffer.Action.delete_after ~n |> on_focused_buffer_or_new)
      *> set_mode Insert
  | Chord (_, n1, Change, n2, Up) ->
      let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
      (Buffer.Action.(bol &> delete_to_eol &> delete_lines_before ~n)
      |> on_focused_buffer_or_new)
      *> set_mode Insert
  (* Delete *)
  | Shortcut (_, n, Delete) ->
      let n = Option.value ~default:1 n - 1 in
      Buffer.Action.(
        delete_to_eol &> move_down &> delete_lines ~n &> move_up &> eol)
      |> on_focused_buffer_or_new
  | Chord (_, n1, Delete, n2, Line) ->
      let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
      Buffer.Action.delete_lines ~n |> on_focused_buffer_or_new
  | Chord (_, n1, Delete, n2, Down) ->
      let n = Option.((value ~default:1 n1 * value ~default:1 n2) + 1) in
      Buffer.Action.delete_lines ~n |> on_focused_buffer_or_new
  | Chord (_, n1, Delete, n2, Left) ->
      let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
      Buffer.Action.delete_before ~n |> on_focused_buffer_or_new
  | Shortcut (_, n, Erase_before) ->
      let n = Option.(value ~default:1 n) in
      Buffer.Action.delete_before ~n |> on_focused_buffer_or_new
  | Chord (_, n1, Delete, n2, Right) ->
      let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
      Buffer.Action.delete_after ~n |> on_focused_buffer_or_new
  | Shortcut (_, n, Erase_after) ->
      let n = Option.(value ~default:1 n) in
      Buffer.Action.delete_after ~n |> on_focused_buffer_or_new
  | Chord (_, n1, Delete, n2, Up) ->
      let n = Option.(value ~default:1 n1 * value ~default:1 n2) in
      Buffer.Action.(delete_lines ~n:1 &> delete_lines_before ~n)
      |> on_focused_buffer_or_new
  (* Join *)
  | Shortcut (_, n, Join) ->
      let n = Option.(value ~default:1 n) in
      Buffer.Action.join_lines ~n |> on_focused_buffer_or_new
  | _ -> noop

let handle_next_command m e =
  match m with
  | Insert -> (
      match Sequence.next e.i_pending with
      | None -> ((), e)
      | Some (h, t) -> handle_insert_command h { e with i_pending = t })
  | Normal -> (
      match Sequence.next e.n_pending with
      | None -> ((), e)
      | Some (h, t) -> handle_normal_command h { e with n_pending = t })

let handle_next_command =
  let open Action in
  get_mode >>= handle_next_command