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