bulk: add PoC of vim-like modular editor

13 files changed, 1187 insertions, 1 deletions

diff --git a/bin/main.ml b/bin/main.ml
index 7bf6048..75328c9 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -1 +1,8 @@
-let () = print_endline "Hello, World!"
+open Sand
+
+let () =
+  let open Editor in
+  let cli = Config.parse Sys.argv in
+  let editor = Editor.init cli in
+  let rec loop () = Action.(render *> handle_next_command2 >>= loop) in
+  Action.eval ~editor loop
diff --git a/lib/command.ml b/lib/command.ml
new file mode 100644
index 0000000..7dedc6c
--- /dev/null
+++ b/lib/command.ml
@@ -0,0 +1,115 @@
+open Base
+open Key
+
+type register = char option
+type count = int option
+type operation = Noop | Yank | Paste | Delete | Change
+type scope = Line | To_bol | To_eol | Down | Left | Right | Up
+
+type command =
+  | Type of char
+  | Simple of Key.t
+  | Partial of Key.t
+  | Shortcut of register * count * operation * scope
+  | Chord of register * count * operation * count * scope
+
+type t = command
+
+let shortcut ?r ?n c s = Shortcut (r, n, c, s)
+let chord ?r ?n1 c ?n2 m = Chord (r, n1, c, n2, m)
+
+let i_stream =
+  let step s k =
+    let open Sequence.Step in
+    match (s, k) with
+    | `start, Key c -> Yield { value = Type c; state = `start }
+    | `start, _ -> Yield { value = Simple k; state = `start }
+    | _, _ -> Skip { state = `start }
+  in
+  Sequence.unfold_with ~init:`start ~f:step Key.stream
+
+let simple_movements =
+  [
+    Key 'h';
+    Key 'j';
+    Key 'k';
+    Key 'l';
+    Key ' ';
+    Arrow_up;
+    Arrow_down;
+    Arrow_left;
+    Arrow_right;
+    Backspace;
+  ]
+
+let to_scope = function
+  | Key 'j' | Arrow_down -> Down
+  | Key 'h' | Arrow_left | Backspace -> Left
+  | Key 'l' | Key ' ' | Arrow_right -> Right
+  | Key 'k' | Arrow_up -> Up
+  | _ -> failwith "Invalid motion."
+
+let n_stream =
+  let step s k =
+    let open Sequence.Step in
+    let is_chord_op c = String.contains "ydc" (Char.lowercase c) in
+    let is_simple_movement k = List.mem ~equal:Poly.equal simple_movements k in
+    let to_op c =
+      match Char.lowercase c with
+      | 'y' -> Yank
+      | 'p' -> Paste
+      | 'd' -> Delete
+      | 'c' -> Change
+      | _ -> failwith "Invalid operation in chord."
+    in
+    match (s, k) with
+    | `start, Key '"' -> Yield { value = Partial k; state = `chord_reg_pre }
+    | `chord_reg_pre, Key c -> Yield { value = Partial k; state = `chord_reg c }
+    | `chord_reg r, Key n when Char.('1' <= n && n <= '9') ->
+        let n = Char.to_int n - 48 in
+        Yield { value = Partial k; state = `chord_n (Some r, n) }
+    | `start, Key n when Char.('1' <= n && n <= '9') ->
+        let n = Char.to_int n - 48 in
+        Yield { value = Partial k; state = `chord_n (None, n) }
+    | `chord_n (r, m), Key n when Char.('0' <= n && n <= '9') ->
+        let n = (10 * m) + Char.to_int n - 48 in
+        Yield { value = Partial k; state = `chord_n (r, n) }
+    | `start, Key c when is_chord_op c ->
+        if Char.is_uppercase c then
+          Yield { value = shortcut (to_op c) To_eol; state = `start }
+        else
+          Yield { value = Partial k; state = `chord_cmd (None, None, to_op c) }
+    | `chord_reg r, Key c when is_chord_op c ->
+        if Char.is_uppercase c then
+          Yield { value = shortcut ~r (to_op c) To_eol; state = `start }
+        else
+          Yield
+            { value = Partial k; state = `chord_cmd (Some r, None, to_op c) }
+    | `chord_n (r, n), Key c when is_chord_op c ->
+        if Char.is_uppercase c then
+          Yield { value = shortcut ?r ~n (to_op c) To_eol; state = `start }
+        else
+          Yield { value = Partial k; state = `chord_cmd (r, Some n, to_op c) }
+    | `chord_cmd (r, n, c), Key ch when is_chord_op ch && Poly.(c = to_op ch) ->
+        if Char.is_uppercase ch then
+          Yield { value = shortcut ?r ?n c To_bol; state = `start }
+        else Yield { value = shortcut ?r ?n c Line; state = `start }
+    | (`start | `chord_reg _), k when is_simple_movement k ->
+        Yield { value = chord Noop (to_scope k); state = `start }
+    | `chord_n (_, n), k when is_simple_movement k ->
+        Yield { value = chord ~n1:n Noop (to_scope k); state = `start }
+    | `chord_cmd (r, n, c), k when is_simple_movement k ->
+        Yield { value = chord ?r ?n1:n c (to_scope k); state = `start }
+    | `chord_cmd (r, n1, c), Key n when Char.('1' <= n && n <= '9') ->
+        let n = Char.to_int n - 48 in
+        Yield { value = Partial k; state = `chord_mv_n (r, n1, c, n) }
+    | `chord_mv_n (r, n1, c, n2), Key n when Char.('0' <= n && n <= '9') ->
+        let n2 = (10 * n2) + Char.to_int n - 48 in
+        Yield { value = Partial k; state = `chord_mv_n (r, n1, c, n2) }
+    | `chord_mv_n (r, n1, c, n2), k when is_simple_movement k ->
+        Yield { value = chord ?r ?n1 c ~n2 (to_scope k); state = `start }
+    (* Catch-all rules *)
+    | `start, _ -> Yield { value = Simple k; state = `start }
+    | _, _ -> Skip { state = `start }
+  in
+  Sequence.unfold_with ~init:`start ~f:step Key.stream
diff --git a/lib/config.ml b/lib/config.ml
new file mode 100644
index 0000000..4ebf436
--- /dev/null
+++ b/lib/config.ml
@@ -0,0 +1,9 @@
+open Base
+
+type config = {
+    files : string list;
+}
+type t = config
+
+let parse args =
+    { files = List.(of_array args |> tl_exn) }
diff --git a/lib/editor.ml b/lib/editor.ml
new file mode 100644
index 0000000..c3e298e
--- /dev/null
+++ b/lib/editor.ml
@@ -0,0 +1,271 @@
+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) ~max:cx dx
+          and dy' = Int.clamp_exn ~min:(cy - cs) ~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.down |> on_focused_buffer
+  | Simple Arrow_left -> Buffer.Action.left |> on_focused_buffer
+  | Simple Arrow_right -> Buffer.Action.right |> on_focused_buffer
+  | Simple Arrow_up -> Buffer.Action.up |> on_focused_buffer
+  | Simple Backspace -> Buffer.Action.delete_before ~n:1 |> on_focused_buffer
+  | Simple (Ctrl 'Q') -> quit 0
+  | Simple Delete -> Buffer.Action.delete_after ~n:1 |> on_focused_buffer
+  | Simple Enter -> Buffer.Action.newline |> on_focused_buffer
+  | Simple Esc -> (Buffer.Action.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.down ?n |> on_focused_buffer
+  | Chord (_, n, Noop, _, Left) -> Buffer.Action.left ?n |> on_focused_buffer
+  | Chord (_, n, Noop, _, Right) -> Buffer.Action.right ?n |> on_focused_buffer
+  | Chord (_, n, Noop, _, Up) -> Buffer.Action.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.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' -> 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 *)
+  | Shortcut (_, n, Change, Line) ->
+      let n = Option.value ~default:1 n - 1 in
+      (Buffer.Action.(delete_lines ~n &> bol &> delete_to_eol)
+      |> on_focused_buffer_or_new)
+      *> set_mode Insert
+  | Shortcut (_, _, Change, To_eol) ->
+      (Buffer.Action.delete_to_eol |> on_focused_buffer_or_new)
+      *> set_mode Insert
+  | Shortcut (_, _, Change, To_bol) ->
+      (Buffer.Action.delete_to_bol |> on_focused_buffer_or_new)
+      *> set_mode Insert
+  (* Delete *)
+  | 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
+  | 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
+  | Chord (_, n1, Delete, n2, Up) ->
+      let n = Option.((value ~default:1 n1 * value ~default:1 n2) + 1) in
+      Buffer.Action.delete_lines_before ~n |> on_focused_buffer_or_new
+  | Shortcut (_, n, Delete, Line) ->
+      Buffer.Action.delete_lines ~n:Option.(value ~default:1 n)
+      |> on_focused_buffer_or_new
+  | Shortcut (_, _, Delete, To_eol) ->
+      Buffer.Action.delete_to_eol |> on_focused_buffer_or_new
+  | Shortcut (_, _, Delete, To_bol) ->
+      Buffer.Action.delete_to_bol |> on_focused_buffer_or_new
+  | _ -> noop
+
+let handle_next_command2 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_command2 =
+  let open Action in
+  get_mode >>= handle_next_command2
diff --git a/lib/editorBuffer.ml b/lib/editorBuffer.ml
new file mode 100644
index 0000000..5104549
--- /dev/null
+++ b/lib/editorBuffer.ml
@@ -0,0 +1,72 @@
+open Base
+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 }
+type t = buffer
+
+let empty =
+  { kind = No_name; content = empty |> push_after empty |> Result.return }
+
+module Action = struct
+  let on_content f b = { b with content = Result.map ~f b.content }
+
+  let up, down, left, right =
+    let vertical f ?(n = 1) =
+      on_content (fun z ->
+          let col = focus_or ~default:Zipper.empty z |> left_length in
+          Fn.apply_n_times ~n f z |> map_focus (goto col))
+    and horizontal f ?(n = 1) =
+      Fn.apply_n_times ~n (map_focus f) |> on_content
+    in
+    (vertical left, vertical right, horizontal left, horizontal right)
+
+  let bol = map_focus far_left |> on_content
+  let eol = map_focus far_right |> on_content
+  let bof = far_left |> on_content
+  let eof = far_right |> on_content
+  let insert k = map_focus (push k) |> on_content
+  let delete_after ~n = Fn.apply_n_times ~n (map_focus pop_after) |> on_content
+  let delete_before ~n = Fn.apply_n_times ~n (map_focus pop) |> on_content
+  let delete_to_eol = map_focus (split &> fst) |> on_content
+  let delete_to_bol = map_focus (split &> snd) |> on_content
+  let delete_lines ~n = Fn.apply_n_times ~n pop_after |> on_content
+
+  let delete_lines_before ~n =
+    on_content (fun z -> pop_after z |> Fn.apply_n_times ~n:(n - 1) pop_before)
+
+  let newline =
+    let aux z =
+      let l1, l2 = focus_or ~default:Zipper.empty z |> split in
+      push_before l1 z |> map_focus (Fn.const l2)
+    in
+    on_content aux
+
+  (* let save_history_to ?(clear = true) r = () *)
+end
+
+let from_file f =
+  let lines = Stdio.In_channel.read_lines f in
+  let line_to_zipper l = String.to_list l |> Sequence.of_list |> of_seq in
+  let content = Sequence.(of_list lines |> map ~f:line_to_zipper) |> of_seq in
+  { kind = File f; content = Ok content }
+
+let cursor b =
+  let open Option in
+  let x = Result.(map ~f:left_length b.content |> ok |> value ~default:0)
+  and y =
+    Result.(map ~f:focus b.content |> ok)
+    |> join |> map ~f:left_length |> value ~default:0
+  in
+  (x, y)
+
+let view x y h w b =
+  match b.content with
+  | Error _ -> Sequence.empty
+  | Ok z ->
+      let cx, _ = cursor b in
+      context ~b:(cx - x) ~a:(x + h - cx) z
+      |> to_seq
+      |> Sequence.map ~f:(window ~from:y ~len:w)
diff --git a/lib/key.ml b/lib/key.ml
new file mode 100644
index 0000000..85aa282
--- /dev/null
+++ b/lib/key.ml
@@ -0,0 +1,72 @@
+open Base
+
+type key =
+  | Arrow_down
+  | Arrow_left
+  | Arrow_right
+  | Arrow_up
+  | Backspace
+  | Ctrl of char
+  | Delete
+  | End
+  | Enter
+  | Esc
+  | Home
+  | Key of char
+  | Nul
+  | Page_down
+  | Page_up
+
+type t = key
+
+let ctrl c = Ctrl c
+let key c = Key c
+
+let of_char = function
+  | '\000' -> Nul
+  | '\013' -> Enter
+  | '\027' -> Esc
+  | '\127' -> Backspace
+  | c when Char.(c < ' ') -> Char.to_int c + 64 |> Char.of_int_exn |> ctrl
+  | c -> Key c
+
+let stream =
+  let step s c =
+    let open Sequence.Step in
+    let escaped = function
+      | 'A' -> Some Arrow_up
+      | 'B' -> Some Arrow_down
+      | 'C' -> Some Arrow_right
+      | 'D' -> Some Arrow_left
+      | 'F' -> Some End
+      | 'H' -> Some Home
+      | _ -> None
+    and tilda = function
+      | '1' -> Some Home
+      | '3' -> Some Delete
+      | '4' -> Some End
+      | '5' -> Some Page_up
+      | '6' -> Some Page_down
+      | '7' -> Some Home
+      | '8' -> Some End
+      | _ -> None
+    in
+    match (s, c) with
+    | `start, Some '\027' -> Skip { state = `esc }
+    | `esc, None -> Yield { value = Esc; state = `start }
+    | `esc, Some '[' | `escaped, Some 'O' -> Skip { state = `escaped }
+    | `escaped, Some i when Char.(i = '1' || ('3' <= i && i <= '8')) ->
+        Skip { state = `tilda i }
+    | `escaped, c -> (
+        match Option.(c >>= escaped) with
+        | None -> Skip { state = `state }
+        | Some c -> Yield { value = c; state = `start })
+    | `tilda i, Some '~' -> (
+        match tilda i with
+        | None -> Skip { state = `start }
+        | Some k -> Yield { value = k; state = `start })
+    | `esc, Some _ | `tilda _, _ -> Skip { state = `start }
+    | _, None -> Skip { state = `start }
+    | _, Some c -> Yield { value = of_char c; state = `start }
+  in
+  Sequence.unfold_with ~init:`start ~f:step Terminal.char_stream
diff --git a/lib/modes.ml b/lib/modes.ml
new file mode 100644
index 0000000..3d0e354
--- /dev/null
+++ b/lib/modes.ml
@@ -0,0 +1,18 @@
+type mode = Normal | Insert
+type t = mode
+type state = int
+type 'a state_monad = state -> 'a * state
+
+let run (f : 'a state_monad) (s : state) : 'a = f s |> fst
+let return (a : 'a) : 'a state_monad = fun s -> (a, s)
+
+let ( >>= ) (f : 'a state_monad) (g : 'a -> 'b state_monad) : 'b state_monad =
+ fun s ->
+  let a, s' = f s in
+  g a s'
+
+let draw () : unit state_monad = return ()
+let get_keypress () : char state_monad = return 'a'
+let handle_key (_ : char) : unit state_monad = return ()
+let rec loop () = () |> draw >>= get_keypress >>= handle_key >>= loop
+let test = run (loop ()) 0
diff --git a/lib/terminal.ml b/lib/terminal.ml
new file mode 100644
index 0000000..408f7a8
--- /dev/null
+++ b/lib/terminal.ml
@@ -0,0 +1,130 @@
+open Base
+open Unix
+open Util
+
+type terminal_size = int * int
+type state = { tio : terminal_io; size : terminal_size }
+
+let escape ?(prefix = "") ?(args = []) op =
+  let open Bytes in
+  let args = List.map ~f:Int.to_string args |> String.concat ~sep:";" in
+  let lenp = String.length prefix in
+  let lena = String.length args in
+  let lenb = 3 + lena + lenp in
+  let dst = Bytes.create lenb in
+  set dst 0 '\x1b';
+  set dst 1 '[';
+  From_string.blit ~src:prefix ~src_pos:0 ~dst ~dst_pos:2 ~len:lenp;
+  From_string.blit ~src:args ~src_pos:0 ~dst ~dst_pos:(2 + lenp) ~len:lena;
+  set dst (length dst - 1) op;
+  sequence_of_bytes dst
+
+let clear_screen = escape 'J' ~args:[ 2 ]
+let clear_to_eol = escape 'K'
+let move_cursor x y = escape 'H' ~args:[ x; y ]
+let move_down n = escape 'B' ~args:[ n ]
+let move_right n = escape 'C' ~args:[ n ]
+let query_cursor_pos = escape 'n' ~args:[ 6 ]
+let reset_cursor = move_cursor 1 1
+
+let show_cursor show =
+  let cmd = if show then 'h' else 'l' in
+  escape cmd ~prefix:"?" ~args:[ 25 ]
+
+let input_bytes = Bytes.create 1
+
+let get_char () =
+  let syscall () = read stdin input_bytes 0 1 in
+  match handle_unix_error syscall () with
+  | 0 -> None
+  | _ -> Some (Bytes.get input_bytes 0)
+
+let char_stream : char option Sequence.t =
+  Sequence.unfold ~init:() ~f:(fun s -> Some (get_char (), s))
+
+let write_seq =
+  let syscall s =
+    let buf = Sequence.to_list s |> Bytes.of_char_list in
+    single_write stdout buf 0 (Bytes.length buf) |> ignore
+  in
+  handle_unix_error syscall
+
+let write_lines (lines : char Sequence.t Sequence.t) =
+  let crnl = Sequence.of_list [ '\r'; '\n' ] in
+  let clear s = Sequence.append s clear_to_eol in
+  let syscall seq =
+    let buf =
+      Sequence.(map ~f:clear seq |> intersperse ~sep:crnl |> concat |> to_list)
+      |> Bytes.of_char_list
+    in
+    single_write stdout buf 0 (Bytes.length buf) |> ignore
+  in
+  handle_unix_error syscall lines
+
+let cmds_to_sequence l = Sequence.(of_list l |> concat)
+
+let restore_screen () =
+  cmds_to_sequence [ clear_screen; reset_cursor; show_cursor true ] |> write_seq
+
+let redraw screen (x, y) =
+  let pre = cmds_to_sequence [ show_cursor false; reset_cursor ]
+  and post = cmds_to_sequence [ move_cursor x y; show_cursor true ] in
+  write_seq pre;
+  write_lines screen;
+  write_seq post
+
+let get_state () = { tio = handle_unix_error tcgetattr stdin; size = (-1, -1) }
+
+let size =
+  let query () =
+    cmds_to_sequence [ move_right 999; move_down 999; query_cursor_pos ]
+    |> write_seq
+  and get_reply () =
+    Sequence.(
+      char_stream
+      |> take_while ~f:Option.is_some
+      |> Fn.flip drop_eagerly 2 (* Drop escape sequence '<esc>[' *)
+      |> map ~f:(Option.value ~default:'R')
+      |> take_while ~f:(fun c -> Char.(c <> 'R'))
+      |> to_list |> String.of_char_list |> Stdlib.Scanf.sscanf
+      |> fun scanner -> scanner "%d;%d" (fun a b -> (a, b)))
+  in
+  query &> get_reply
+
+let enable_raw_mode tio =
+  let syscall () =
+    tcsetattr stdin TCSAFLUSH
+      {
+        tio with
+        c_brkint = false;
+        c_csize = 8;
+        c_echo = false;
+        c_echonl = false;
+        c_icanon = false;
+        c_icrnl = false;
+        c_ignbrk = false;
+        c_igncr = false;
+        c_inlcr = false;
+        c_inpck = false;
+        c_isig = false;
+        c_istrip = false;
+        c_ixon = false;
+        c_opost = false;
+        c_parenb = false;
+        c_parmrk = false;
+        c_vmin = 0;
+        c_vtime = 1;
+      }
+  in
+  handle_unix_error syscall
+
+let restore_status tio =
+  let syscall () = tcsetattr stdin TCSAFLUSH tio in
+  handle_unix_error syscall
+
+let init () =
+  let state = get_state () in
+  enable_raw_mode state.tio ();
+  restore_status state.tio |> Stdlib.at_exit;
+  restore_screen |> Stdlib.at_exit;
+  { state with size = size () }
diff --git a/lib/terminal.mli b/lib/terminal.mli
new file mode 100644
index 0000000..0fd11ed
--- /dev/null
+++ b/lib/terminal.mli
@@ -0,0 +1,67 @@
+(** A module to simplify communication with the underlying terminal
+    emulator. *)
+
+open Base
+open Unix
+
+type terminal_size = int * int
+(** Size of the terminal window. *)
+
+type state = {
+  tio : terminal_io;  (** Status flags for the terminal window *)
+  size : terminal_size;  (** Size of the terminal window *)
+}
+(** Global state of the terminal window. *)
+
+val get_char : unit -> char option
+(** Non-blocking request for a keypress.
+    Use {!val:Terminal.char_stream} for an infinite sequence of input
+    bytes.
+
+    @return A [char] if a key was pressed, nothing otherwise. *)
+
+val char_stream : char option Sequence.t
+(** The infinite stream of input bytes from stdin.
+    Returns [None] if no key was pressed; this is to be able to
+    interpret the absense of a keypress as an action. *)
+
+val write_seq : char Sequence.t -> unit
+(** Write a sequence of strings to standard output.
+
+    @param seq The sequence of strings to output. *)
+
+val restore_screen : unit -> unit
+(** Clear screen and show cursor. Meant to be called on exit. *)
+
+val redraw : char Sequence.t Sequence.t -> int * int -> unit
+(** Redraw the screen, using the provided sequence of lines.
+
+    @param seq A sequence of lines.
+    @param cur Cursor position. *)
+
+val get_state : unit -> state
+(** Get current state for the terminal window *)
+
+val size : unit -> int * int
+(** Compute the current size of the terminal.
+
+    This is done by moving the cursor to the far bottom right position
+    and querying for the cursor position using the appropriate escape
+    sequences.
+
+    @return size of the terminal window in terms of character rows and columns. *)
+
+val enable_raw_mode : terminal_io -> unit -> unit
+(** Turn on raw mode by overriding the correct terminal flags.
+    This is done according to [man 3 termios].
+
+    @param tio The current status of the terminal for [stdin]. *)
+
+val restore_status : terminal_io -> unit -> unit
+(** Override the terminal status.
+
+    @param tio The new terminal status for [stdin]. *)
+
+val init : unit -> state
+(** Turns on raw mode and makes sure to restore the previous terminal
+    status on exit. *)
diff --git a/lib/text.ml b/lib/text.ml
new file mode 100644
index 0000000..ff1f727
--- /dev/null
+++ b/lib/text.ml
@@ -0,0 +1,10 @@
+open Base
+open Sequence
+open Sequence.Infix
+
+let center ~fill n text =
+  let padding = repeat fill and len_t = length text in
+  let len_p = (n - len_t) / 2 in
+  take (take padding len_p @ text @ padding) n
+
+let extend ~fill n text = take (text @ repeat fill) n
diff --git a/lib/util.ml b/lib/util.ml
new file mode 100644
index 0000000..9ad3b59
--- /dev/null
+++ b/lib/util.ml
@@ -0,0 +1,26 @@
+(** The infamous [Util] module. A graveyard of broken expressions. *)
+
+open Base
+
+(** [f &> g] composes [g] with [f] to obrain [fun x -> g (f x)];
+    in other words, it applies [f] {i and then} [g].
+
+    @param f the first funtion to apply.
+    @param g the second function to apply.
+    @return the composition of [g] with [f]. *)
+let ( &> ) f g = Fn.compose g f
+
+(** Turn a sequence of bytes into a sequence.
+
+    @param b the input bytes.
+    @return a sequence of bytes. *)
+let sequence_of_bytes (b : Bytes.t) : char Sequence.t =
+  let open Sequence.Generator in
+  let traverse b =
+    let len = Bytes.length b in
+    let rec loop i _ =
+      if i >= len then return () else yield (Bytes.get b i) >>= loop (i + 1)
+    in
+    loop 0 ()
+  in
+  traverse b |> run
diff --git a/lib/zipper.ml b/lib/zipper.ml
new file mode 100644
index 0000000..2322a58
--- /dev/null
+++ b/lib/zipper.ml
@@ -0,0 +1,131 @@
+(* Module [Zipper]: functional zippers *)
+
+open Base
+
+type !+'a zipper = {
+  pos : int;
+  popped : 'a Sequence.t;
+  before : 'a Sequence.t;
+  after : 'a Sequence.t;
+}
+
+type !+'a t = 'a zipper
+
+let empty =
+  {
+    pos = 0;
+    popped = Sequence.empty;
+    before = Sequence.empty;
+    after = Sequence.empty;
+  }
+
+let before z = z.before
+let after z = z.after
+let focus z = after z |> Sequence.next |> Option.map ~f:fst
+let focus_or z ~default = Option.value ~default (focus z)
+let history z = z.popped
+let is_far_left z = before z |> Sequence.is_empty
+let is_far_right z = after z |> Sequence.is_empty
+let is_empty z = is_far_left z && is_far_right z
+let left_length z = z.pos
+let right_length z = after z |> Sequence.length
+let length z = left_length z + right_length z
+
+let left z =
+  match Sequence.next z.before with
+  | None -> z
+  | Some (h, t) ->
+      {
+        z with
+        pos = z.pos - 1;
+        before = t;
+        after = Sequence.shift_right z.after h;
+      }
+
+let rec left_while f z =
+  if (not (is_far_left z)) && Option.(focus z |> map ~f |> value ~default:false)
+  then left z |> left_while f
+  else z
+
+let rec far_left z = if is_far_left z then z else z |> left |> far_left
+
+let right z =
+  match Sequence.next z.after with
+  | None -> z
+  | Some (h, t) ->
+      {
+        z with
+        pos = z.pos + 1;
+        before = Sequence.shift_right z.before h;
+        after = t;
+      }
+
+let rec right_while f z =
+  if
+    (not (is_far_right z)) && Option.(focus z |> map ~f |> value ~default:false)
+  then right z |> right_while f
+  else z
+
+let rec far_right z = if is_far_right z then z else z |> right |> far_right
+
+let goto n z =
+  let n = n - z.pos in
+  let step = if n < 0 then left else right in
+  Fn.apply_n_times ~n:(abs n) step z
+
+let pop_after z = { z with after = Sequence.drop_eagerly z.after 1 }
+let pop_before z = if is_far_left z then z else z |> left |> pop_after
+let pop = pop_before
+let push_after x z = { z with after = Sequence.shift_right z.after x }
+
+let push_before x z =
+  { z with pos = z.pos + 1; before = Sequence.shift_right z.before x }
+
+let push = push_before
+
+let split z =
+  ( { z with after = Sequence.empty },
+    { z with pos = 0; before = Sequence.empty } )
+
+let iter_before f z = Sequence.iter ~f z.before
+let iter_after f z = Sequence.iter ~f z.after
+
+let iter f z =
+  iter_before f z;
+  iter_after f z
+
+let for_all f z = Sequence.(for_all ~f z.before && for_all ~f z.after)
+let exists f z = Sequence.(exists ~f z.before || exists ~f z.after)
+let find_before f z = Sequence.find ~f z.before
+let find_after f z = Sequence.find ~f z.after
+let map_before f z = { z with before = Sequence.map ~f z.before }
+let map_after f z = { z with after = Sequence.map ~f z.after }
+
+let map_focus f z =
+  match Sequence.next z.after with
+  | None -> z
+  | Some (h, t) -> { z with after = Sequence.shift_right t (f h) }
+
+let map f z =
+  { z with before = Sequence.map ~f z.before; after = Sequence.map ~f z.after }
+
+let mapi_before f z = { z with before = Sequence.mapi ~f z.before }
+let mapi_after f z = { z with after = Sequence.mapi ~f z.after }
+
+let mapi f z =
+  {
+    z with
+    before = Sequence.mapi ~f z.before;
+    after = Sequence.mapi ~f z.after;
+  }
+
+let filter_before f z = { z with before = Sequence.filter ~f z.before }
+let filter_after f z = { z with after = Sequence.filter ~f z.after }
+let filter p z = z |> filter_before p |> filter_after p
+let context_before n z = { z with before = Sequence.take z.before n }
+let context_after n z = { z with after = Sequence.take z.after n }
+let context ~b ?(a = b) z = z |> context_before b |> context_after a
+let clear_history z = { z with popped = Sequence.empty }
+let of_seq s = { empty with after = s }
+let to_seq z = z |> far_left |> after
+let window ~from ~len z = goto from z |> context_after len |> after
diff --git a/lib/zipper.mli b/lib/zipper.mli
new file mode 100644
index 0000000..c3c79a6
--- /dev/null
+++ b/lib/zipper.mli
@@ -0,0 +1,258 @@
+open Base
+
+(** Linear zippers.
+
+    A zipper represents {b a paused traversal} of a certain data
+    structure. A linear zipper of type ['a zipper] represents a zipper
+    over a sequence of ['a] elements.
+
+    One can access the {b focused element} of the zipper with [focus].
+    The focus of a zipper is also known as the the {b cursor} of the
+    zipper, and can be moved back and forth with [left] and [right].
+
+    Elements can be added or removed at the cursor's position with
+    [push] and [pop] operations. Variants are available, e.g., to act
+    before the cursor, with suffix [_before], or after the cursor, with
+    suffix [_after]. *)
+
+type !+'a zipper
+(** A zipper is represented as a {b pair} of sequences of type ['a]. The
+    focus of the zipper is the element at the head of the second
+    sequence, if any.
+
+    Note that the first sequence is reversed. Given a sequence
+    [[1; 2; 3; 4; {5}; 6; 7]], where we represent the cursor using
+    curly braces [{_}], its representation as a zipper is
+    [([4; 3; 2; 1], [5; 6; 7])]. *)
+
+type !+'a t = 'a zipper
+(** An alias for the ['a zipper] type. *)
+
+val empty : 'a zipper
+(** Return an empty zipper *)
+
+val before : 'a zipper -> 'a Sequence.t
+(** Return the sequence before the cursor *)
+
+val after : 'a zipper -> 'a Sequence.t
+(** Return the sequence after the cursor *)
+
+val focus : 'a zipper -> 'a option
+(** Return the focus of the zipper, if any. *)
+
+val focus_or : 'a zipper -> default:'a -> 'a
+(** Return the focus of the zipper, or a user-provided default, otherwise. *)
+
+val history : 'a zipper -> 'a Sequence.t
+(** Returns the sequence of elements [pop]ped so far from the zipper. *)
+
+val is_far_left : 'a zipper -> bool
+(** Return whether the cursor is at the beginning of the zipper. *)
+
+val is_far_right : 'a zipper -> bool
+(** Return whether the cursor is at the end of the zipper. *)
+
+val is_empty : 'a zipper -> bool
+(** Return whether the zipper is empty. *)
+
+val left_length : 'a zipper -> int
+(** Return the number of elements before the cursor. *)
+
+val right_length : 'a zipper -> int
+(** Return the number of elements  after the cursor. *)
+
+val length : 'a zipper -> int
+(** Return the length of the zipper. *)
+
+(** {1 Moving the cursor} *)
+
+val left : 'a zipper -> 'a zipper
+(** Move the cursor one step to the left, if possible.
+    Calling [left z],
+
+        - if [z] is [([3; 2; 1], [4; 5])], the result is [([2; 1], [3; 4; 5])], 
+        - if [z] is [([], [1; 2; 3])], the result is [([], [1; 2; 3])].
+    *)
+
+val left_while : ('a -> bool) -> 'a zipper -> 'a zipper
+(** [left_while f z] moves the cursor in [z] to the left as long as the
+    predicate [f] is [true] when applied to the focus, or the left end
+    of the zipper is reached. *)
+
+val far_left : 'a zipper -> 'a zipper
+(** Move the cursor to the left, as much as possible. *)
+
+val right : 'a zipper -> 'a zipper
+(** Move the cursor one step to the right, if possible.
+    Calling [right z],
+
+        - if [z] is [([3; 2; 1], [4; 5])], the result is [([4; 3; 2; 1], [5])], 
+        - if [z] is [([1; 2; 3], [])], the result is [([1; 2; 3], [])].
+    *)
+
+val right_while : ('a -> bool) -> 'a zipper -> 'a zipper
+(** [right_while f z] moves the cursor in [z] to the right as long as
+    the predicate [f] is [true] when applied to the focus, or the right
+    end of the zipper is reached. *)
+
+val far_right : 'a zipper -> 'a zipper
+(** Move the cursor to the right, as much as possible. *)
+
+val goto : int -> 'a zipper -> 'a zipper
+(** Move the cursor to a specific (absolute) position in the zipper.
+    Depending on the current position, it either moves the cursor
+    forward or backwards, without crossing the zipper boundaries. *)
+
+(** {1 Changes at the cursor} *)
+
+(** Zippers provide [O(1)] operations performed at the cursor position.
+    This involve [push]ing and [pop]ping elements before and after the
+    cursor. *)
+
+val pop_after : 'a zipper -> 'a zipper
+(** Remove the element at the cursor position, if any, and return the
+    modified zipper. Calling [pop_after z],
+
+        - if [z] is [([3; 2; 1], [4; 5])], the result is [([3; 2; 1], [5])], 
+        - if [z] is [([1; 2; 3], [])], the result is [([1; 2; 3], [])].
+    *)
+
+val pop_before : 'a zipper -> 'a zipper
+(** Remove the element before the cursor, if any, and return the
+    modified zipper. Calling [pop_before z],
+
+        - if [z] is [([3; 2; 1], [4; 5])], the result is [([2; 1], [4, 5])], 
+        - if [z] is [([], [1; 2; 3])], the result is [([], [1; 2; 3])].
+    *)
+
+val pop : 'a zipper -> 'a zipper
+(** [pop] is an alias for [pop_before]. *)
+
+val push_after : 'a -> 'a zipper -> 'a zipper
+(** Insert an element after the cursor.
+    Calling [push_after 0 z], if [z] is [([3; 2; 1], [4; 5])],
+    the result is [([3; 2; 1], [0; 4, 5]))], *)
+
+val push_before : 'a -> 'a zipper -> 'a zipper
+(** Insert an element before the cursor. Return the modified zipper.
+    Calling [push_before 0 z], if [z] is [([3; 2; 1], [4; 5])],
+    the result is [([0; 3; 2; 1], [4, 5]))]. *)
+
+val push : 'a -> 'a zipper -> 'a zipper
+(** [push] is an alias for [push_before]. *)
+
+val split : 'a zipper -> 'a zipper * 'a zipper
+(** [split z] splits the zipper in two. [([3; 2; 1], [4; 5])] becomes
+    [([3; 2; 1], []), ([], [4; 5])]. *)
+
+(** {1 Consuming zippers} *)
+
+(** Since zippers are based on sequences, iterating over zippers
+    terminates only when both sequences are finite.
+    Unless otherwise stated, these functions will iterate on the
+    elements before the cursor, first. *)
+
+val iter_before : ('a -> unit) -> 'a zipper -> unit
+(** [iter_before f z] will call [f x] for all [x], elements before the
+    cursor in [z].*)
+
+val iter_after : ('a -> unit) -> 'a zipper -> unit
+(** [iter_after f z] will call [f x] for all [x], elements after the
+    cursor in [z].*)
+
+val iter : ('a -> unit) -> 'a zipper -> unit
+(** [iter f z] is equivalent to [iter_before f z; iter_after f z] *)
+
+val for_all : ('a -> bool) -> 'a zipper -> bool
+(** [for_all p z] tests whether a predicate [p] is [true] for all
+    elements in a zipper. *)
+
+val exists : ('a -> bool) -> 'a zipper -> bool
+(** [exists p z] tests whether at least one element in the zipper is
+    [true] according to the predicate [p]. *)
+
+val find_before : ('a -> bool) -> 'a zipper -> 'a option
+(** [find_before p z] will return the first element before the cursor in
+    [z] satisfying the predicate [p], if any. *)
+
+val find_after : ('a -> bool) -> 'a zipper -> 'a option
+(** [find_after p z] will return the first element after the cursor in
+    [z] satisfying the predicate [p], if any. *)
+
+(** {1 Transforming zippers} *)
+
+(** Since zippers are based on sequences, the functions in this section
+    are lazy; i.e., resulting elements of the zipper are computed only
+    when demanded. *)
+
+val map_before : ('a -> 'a) -> 'a zipper -> 'a zipper
+(** Map a function over all elements before the cursor. *)
+
+val map_after : ('a -> 'a) -> 'a zipper -> 'a zipper
+(** Map a function over all elements after the cursor. *)
+
+val map_focus : ('a -> 'a) -> 'a zipper -> 'a zipper
+(** Map a function over the element focused by the cursor, if any. *)
+
+val map : ('a -> 'a) -> 'a zipper -> 'a zipper
+(** Map a function over all elements of a zipper. *)
+
+val mapi_before : (int -> 'a -> 'a) -> 'a zipper -> 'a zipper
+(** [mapi_before] is analogous to {!Zipper.map_before}, but the function
+    takes an index and an element.
+    The index indicates the distance of an element from the cursor. *)
+
+val mapi_after : (int -> 'a -> 'a) -> 'a zipper -> 'a zipper
+(** [mapi_after] is analogous to {!Zipper.map_after}, but the function
+    takes an index and an element.
+    The index indicates the distance of an element from the cursor. *)
+
+val mapi : (int -> 'a -> 'a) -> 'a zipper -> 'a zipper
+(** [mapi] is analogous to {!Zipper.map}, but the function takes an
+    index and an element.
+    The index indicates the distance of an element from the cursor. *)
+
+val filter_before : ('a -> bool) -> 'a zipper -> 'a zipper
+(** [filter_before p z] filters the elements before the cursor in a
+    zipper [z] according to a predicate [p], i.e., keeping the elements
+    that satisfy the predicate. *)
+
+val filter_after : ('a -> bool) -> 'a zipper -> 'a zipper
+(** [filter_after p z] filters the elements after the cursor in a
+    zipper [z] according to a predicate [p], i.e., keeping the elements
+    that satisfy the predicate. *)
+
+val filter : ('a -> bool) -> 'a zipper -> 'a zipper
+(** [filter p z] filters the elements of the zipper [z] according to a
+    predicate [p], i.e., keeping the elements that satisfy the
+    predicate. *)
+
+val context_before : int -> 'a zipper -> 'a zipper
+(** [context_before n z] will limit the zipper [z] to [n] elements before
+    the cursor. *)
+
+val context_after : int -> 'a zipper -> 'a zipper
+(** [context_after n z] will limit the zipper [z] to [n] elements after
+    the cursor. *)
+
+val context : b:int -> ?a:int -> 'a zipper -> 'a zipper
+(** [context ~b ~a z] will limit the zipper [z] to [b] elements before
+    the cursor and [a] elements after the cursor. When [a] is not
+    provided, it defaults to [b]. *)
+
+val clear_history : 'a zipper -> 'a zipper
+(** Clear the history of the zipper. See {!Zipper.history}. *)
+
+(** {1 Zippers and sequences} *)
+
+val of_seq : 'a Sequence.t -> 'a zipper
+(** Turn a sequence into a zipper with the cursor at the beginning. *)
+
+val to_seq : 'a zipper -> 'a Sequence.t
+(** Return the zipper as a sequence.
+    Calling [to_seq z], with [z] being [([3; 2; 1], [4; 5])], results in
+    [[1; 2; 3; 4; 5]]. *)
+
+val window : from:int -> len:int -> 'a zipper -> 'a Sequence.t
+(** [windows from len z] returns a sequence containing [len] elements
+    starting from [from]. *)