path: root/lib/editor.ml

open Base
module Buffer = EditorBuffer
open Util

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

type editor = {
  term : Terminal.state;
  mode : mode;
  offset : int * int;
  cursor : cursor;
  buffer : Buffer.t option;
  rendered : bool;
  istream : Command.t Sequence.t;
  nstream : Command.t Sequence.t;
  status_size : int;
  message : string option;
  message_timestamp : float;
  message_duration : float;
  pending_command : string;
}

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;
    rendered = true;
    istream = Command.i_stream;
    nstream = Command.n_stream;
    status_size = 2;
    message = Some "Hello, control line!";
    message_timestamp = Unix.time ();
    message_duration = 5.;
    pending_command = "";
  }

let string_of_mode = function
  | Insert -> " I "
  | Normal -> " N "
  | Control -> " C "

let statusbar e =
  let open Text in
  (* let open Sequence.Infix in *)
  let w = e.term.size |> snd in
  let status =
    let mode = e.mode |> string_of_mode |> sequence_of_string in
    let msize = Sequence.length mode
    and path =
      Buffer.(
        e.buffer |> Option.map ~f:kind
        |> Option.value ~default:No_name
        |> string_of_kind |> sequence_of_string)
    and br, bc =
      Option.(e.buffer |> map ~f:Buffer.size |> value ~default:(0, 0))
    and cr, cc =
      Option.(
        e.buffer
        |> map ~f:(Buffer.cursor ~rendered:false)
        |> value ~default:(0, 0))
    in
    let perc =
      match cr with
      | 0 -> "Top"
      | n when n = br -> "Bot"
      | n -> Printf.sprintf "%2d%%" (100 * n / br)
    in
    let nav =
      Printf.sprintf "%d/%d %2d/%2d [%s] " cr br cc bc perc
      |> sequence_of_string
    in
    let nsize = Sequence.length nav in
    spread ~l:(bold mode) ~lsize:msize ~c:path ~r:(bold nav) ~rsize:nsize
      ~fill:' ' w
    |> invert
  and control =
    let msg = Option.value ~default:"" e.message |> sequence_of_string
    and cmd = e.pending_command |> sequence_of_string in
    spread ~l:msg ~r:cmd ~fill:' ' w
  in
  Sequence.(take (of_list [ status; control ]) e.status_size)

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
      (* Limit cursor to buffer view *)
      let rs = rs - e.status_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 e = (e.mode, e)
  let set_mode m e = ((), { e with mode = m })
  let get_focused_buffer e = (e.buffer, e)
  let set_focused_buffer b e = ((), { e with buffer = Some b })
  let get_terminal_size e = (e.term.size, e)

  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 '~'
      and status = statusbar e
      and limit =
        Buffer.(if e.rendered then rendered_view else unrendered_view)
      in
      let ssize = e.status_size in
      let bufview =
        Option.(
          e.buffer
          >>| limit x y (r - ssize) c
          |> value ~default:(welcome size)
          |> Text.extend ~fill r
          |> Fn.flip Sequence.take (r - ssize))
      in
      let screen = Sequence.append bufview status in
      Terminal.redraw screen e.cursor
    in
    get >>| aux

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

  (* Statusbar *)
  let set_message m e =
    ((), { e with message = m; message_timestamp = Unix.time () })

  let get_pending_command e = (e.pending_command, e)
  let set_pending_command p e = ((), { e with pending_command = p })

  let append_pending_command k =
    let aux p = p ^ Key.to_string k in
    get_pending_command >>| aux >>= set_pending_command

  let clear_pending_command = set_pending_command ""

  let tick =
    let check_message_timestamp e =
      let now = Unix.time () in
      let expired = Float.(e.message_timestamp < now - e.message_duration) in
      if Option.is_some e.message && expired then { e with message = None }
      else e
    in
    get >>| check_message_timestamp >>= put

  (* Debug *)
  let get_rendered e = (e.rendered, e)
  let set_rendered r e = ((), { e with rendered = r })
  let toggle_rendered = get_rendered >>| not >>= set_rendered
  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
  | Simple Page_down | Simple (Ctrl 'F') ->
      fun e ->
        (* TODO consider using the buffer window size (i.e., subtract status_size) *)
        let (n, _), e = get_terminal_size e in
        on_focused_buffer (Buffer.Action.move_down ~n) e
  | Simple Page_up | Simple (Ctrl 'B') ->
      fun e ->
        let (n, _), e = get_terminal_size e in
        on_focused_buffer (Buffer.Action.move_up ~n) e
  | Simple (Ctrl 'D') ->
      fun e ->
        let (r, _), e = get_terminal_size e in
        on_focused_buffer (Buffer.Action.move_down ~n:(r / 2)) e
  | Simple (Ctrl 'U') ->
      fun e ->
        let (r, _), e = get_terminal_size e in
        on_focused_buffer (Buffer.Action.move_up ~n:(r / 2)) e
  | Simple Home -> Buffer.Action.bol |> on_focused_buffer
  | Simple End -> Buffer.Action.eol |> on_focused_buffer
  | Simple Tab -> Buffer.Action.insert '\t' |> on_focused_buffer
  | Type k -> Buffer.Action.insert k |> on_focused_buffer
  | _ -> noop

let handle_normal_command c =
  let open Command in
  let open Action in
  let update_command_cue =
    match c with
    | Partial k -> append_pending_command k
    | _ -> clear_pending_command
  and compute_action =
    match c with
    (* 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
    | Chord (_, n, Noop, _, To_bol) ->
        let n = Option.value ~default:1 n - 1 in
        Buffer.Action.(move_down ~n &> bol) |> on_focused_buffer
    | Chord (_, n, Noop, _, To_eol) ->
        let n = Option.value ~default:1 n - 1 in
        Buffer.Action.(move_down ~n &> eol) |> on_focused_buffer
    | Simple Page_down | Simple (Ctrl 'F') ->
        fun e ->
          let (n, _), e = get_terminal_size e in
          on_focused_buffer (Buffer.Action.move_down ~n) e
    | Simple Page_up | Simple (Ctrl 'B') ->
        fun e ->
          let (n, _), e = get_terminal_size e in
          on_focused_buffer (Buffer.Action.move_up ~n) e
    | Simple (Ctrl 'D') ->
        fun e ->
          let (r, _), e = get_terminal_size e in
          on_focused_buffer (Buffer.Action.move_down ~n:(r / 2)) e
    | Simple (Ctrl 'U') ->
        fun e ->
          let (r, _), e = get_terminal_size e in
          on_focused_buffer (Buffer.Action.move_up ~n:(r / 2)) e
    (* 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
    | Chord (_, n1, Change, n2, To_bol) ->
        let n = Option.((value ~default:1 n1 * value ~default:1 n2) - 1) in
        (Buffer.Action.(
           delete_to_bol &> move_down &> delete_lines ~n &> move_up &> bol)
        |> on_focused_buffer_or_new)
        *> set_mode Insert
    | Chord (_, n1, Change, n2, To_eol) ->
        let n = Option.((value ~default:1 n1 * value ~default:1 n2) - 1) in
        (Buffer.Action.(
           delete_to_eol &> move_down &> delete_lines ~n &> move_up &> eol)
        |> 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
    | Chord (_, n1, Delete, n2, To_bol) ->
        let n = Option.((value ~default:1 n1 * value ~default:1 n2) - 1) in
        Buffer.Action.(
          delete_to_bol &> move_down &> delete_lines ~n &> move_up &> bol)
        |> on_focused_buffer_or_new
    | Chord (_, n1, Delete, n2, To_eol) ->
        let n = Option.((value ~default:1 n1 * value ~default:1 n2) - 1) in
        Buffer.Action.(
          delete_to_eol &> move_down &> delete_lines ~n &> move_up &> eol)
        |> 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
    (* Quit *)
    | Simple (Ctrl 'Q') -> quit 0
    (* Misc *)
    | 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 *)
    (* Debug *)
    | Simple (Ctrl 'R') -> toggle_rendered
    | _ -> noop
  in
  compute_action *> update_command_cue

let handle_next_command m e =
  match m with
  | Insert -> (
      match Sequence.next e.istream with
      | None -> ((), e)
      | Some (h, t) -> handle_insert_command h { e with istream = t })
  | Normal -> (
      match Sequence.next e.nstream with
      | None -> ((), e)
      | Some (h, t) -> handle_normal_command h { e with nstream = t })
  | Control -> failwith "unimplemented"

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