open Base
module Buffer = EditorBuffer
open Util

type mode = Normal | Insert | Control

type selection =
  | Empty
  | Glyphwise of char Sequence.t Sequence.t
  | Linewise of char Sequence.t Sequence.t

type cursor = int * int

type editor = {
  term : Terminal.state;
  mode : mode;
  offset : int * int;
  cursor : cursor;
  buffer : Buffer.t;
  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;
  registers : selection Array.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
      |> Option.value ~default:Buffer.empty;
    rendered = true;
    istream = Command.i_stream;
    nstream = Command.n_stream;
    status_size = 2;
    message = Some "Welcome to the sandy editor!";
    message_timestamp = Unix.time ();
    message_duration = 5.;
    pending_command = "";
    registers = Array.create ~len:128 Empty;
  }

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 lsize = Sequence.length mode
    and c = e.buffer.kind |> Buffer.string_of_kind |> sequence_of_string
    and br, bc = Buffer.size e.buffer
    and cr, cc = Buffer.cursor ~rendered:false e.buffer 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 rsize = Sequence.length nav in
    spread ~l:(bold mode) ~lsize ~c ~r:(bold nav) ~rsize ~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
      let cx, cy = Buffer.cursor e.buffer in
      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_focused_buffer e = (e.buffer, e)
  let set_focused_buffer b e = ((), { e with buffer = b })

  let get_mode e = (e.mode, e)
  let set_mode m e = ((), { e with mode = m })
  let get_terminal_size e = (e.term.size, e)

  let get_register r e =
    assert (Char.('!' <= r && r <= '~'));
    (e.registers.(Char.to_int r), e)

  let set_register r z e =
    assert (Char.('!' <= r && r <= '~'));
    e.registers.(Char.to_int '"') <- z;
    e.registers.(Char.to_int r) <- z;
    ((), 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 aux e =
      let x, y = e.offset
      and r, c = e.term.size
      and fill = Sequence.singleton '~'
      and status = statusbar e
      and limit =
        (* debug *)
        Buffer.(if e.rendered then rendered_view else unrendered_view)
      in
      let ssize = e.status_size in
      let bufview =
        e.buffer
        |> limit x y (r - ssize) c
        |> 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 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
    (* Paste *)
    | Shortcut (r, n, Paste_after) ->
        let r = Option.value ~default:'"' r in
        let paste = function
          | Empty -> noop
          | Glyphwise z -> Buffer.Action.paste ?n z |> on_focused_buffer_or_new
          | Linewise z ->
              Buffer.Action.paste ~linewise:true ?n z
              |> on_focused_buffer_or_new
        in
        get_register r >>= paste
    | Shortcut (r, n, Paste_before) ->
        let r = Option.value ~default:'"' r in
        let paste = function
          | Empty -> noop
          | Glyphwise z ->
              Buffer.Action.paste ~before:true ?n z |> on_focused_buffer_or_new
          | Linewise z ->
              Buffer.Action.paste ~before:true ~linewise:true ?n z
              |> on_focused_buffer_or_new
        in
        get_register r >>= paste
    (* Join *)
    | Shortcut (_, n, Join) ->
        let n = Option.(value ~default:2 n) in
        Buffer.Action.join_lines ~n |> on_focused_buffer
    (* 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