feat: add plain search functionality (with history)

6 files changed, 229 insertions, 38 deletions

diff --git a/lib/command.ml b/lib/command.ml
index 9ab36f6..ac1dbf1 100644
--- a/lib/command.ml
+++ b/lib/command.ml
@@ -14,6 +14,8 @@ type operation =
   | Paste_after
   | Erase_before
   | Erase_after
+  | Search
+  | Search_rev
 
 type scope = Line | To_bol | To_eol | Down | Left | Right | Up
 
@@ -70,7 +72,18 @@ let to_scope = function
 let is_simple_movement k = List.mem ~equal:Poly.equal simple_movements k
 
 let instant_operation =
-  [ Key 'C'; Key 'D'; Key 'Y'; Key 'J'; Key 'P'; Key 'X'; Key 'p'; Key 'x' ]
+  [
+    Key 'C';
+    Key 'D';
+    Key 'Y';
+    Key 'J';
+    Key 'n';
+    Key 'N';
+    Key 'P';
+    Key 'X';
+    Key 'p';
+    Key 'x';
+  ]
 
 let chord_operation = [ Key 'c'; Key 'd'; Key 'y' ]
 
@@ -79,6 +92,8 @@ let to_op = function
   | Key 'c' | Key 'C' -> Change
   | Key 'd' | Key 'D' -> Delete
   | Key 'y' | Key 'Y' -> Yank
+  | Key 'n' -> Search
+  | Key 'N' -> Search_rev
   | Key 'p' -> Paste_after
   | Key 'P' -> Paste_before
   | Key 'x' -> Erase_after
diff --git a/lib/control.ml b/lib/control.ml
new file mode 100644
index 0000000..670175c
--- /dev/null
+++ b/lib/control.ml
@@ -0,0 +1,32 @@
+open Base
+
+type t = { prompt : Key.t; content : char Zipper.t }
+type result = Search of bool * char Sequence.t | No_result
+
+let create prompt = { prompt; content = Zipper.empty }
+
+let render c =
+  let prompt = Key.to_string c.prompt |> String.to_list
+  and content = c.content |> Zipper.to_seq in
+  Sequence.shift_right_with_list content prompt
+
+let is_search c = match c.prompt with Key '/' | Key '?' -> true | _ -> false
+
+let cursor c =
+  String.length (Key.to_string c.prompt) + Zipper.left_length c.content + 1
+
+let get_result c =
+  let open Zipper in
+  match c.prompt with
+  | Key '/' -> Search (true, c.content |> to_seq)
+  | Key '?' -> Search (false, c.content |> to_seq)
+  | _ -> No_result
+
+let set_content s c = { c with content = Zipper.(of_seq s |> far_right) }
+let move_left c = { c with content = Zipper.left c.content }
+let move_right c = { c with content = Zipper.right c.content }
+let delete_before c = { c with content = Zipper.pop_before c.content |> snd }
+let delete_after c = { c with content = Zipper.pop c.content |> snd }
+let bol c = { c with content = Zipper.far_left c.content }
+let eol c = { c with content = Zipper.far_right c.content }
+let insert k c = { c with content = Zipper.push_before k c.content }
diff --git a/lib/editor.ml b/lib/editor.ml
index 043c00e..5a68e53 100644
--- a/lib/editor.ml
+++ b/lib/editor.ml
@@ -2,8 +2,6 @@ open Base
 module Buffer = EditorBuffer
 open Util
 
-type mode = Normal | Insert | Control
-
 type selection =
   | Empty
   | Glyphwise of char Sequence.t Sequence.t
@@ -13,7 +11,7 @@ type cursor = int * int
 
 type editor = {
   term : Terminal.state;
-  mode : mode;
+  mode : Mode.t;
   offset : int * int;
   cursor : cursor;
   buffer : Buffer.t;
@@ -26,6 +24,8 @@ type editor = {
   message_duration : float;
   pending_command : string;
   registers : selection Array.t;
+  control : Control.t;
+  search_history : (bool * char Sequence.t) Zipper.t;
 }
 
 type t = editor
@@ -49,19 +49,16 @@ let init (c : Config.t) : editor =
     message_duration = 5.;
     pending_command = "";
     registers = Array.create ~len:128 Empty;
+    control = Control.create Key.Nul;
+    search_history = Zipper.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 mode = e.mode |> Mode.to_string |> 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
@@ -79,9 +76,12 @@ let statusbar e =
     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
+    match e.mode with
+    | Control -> Control.render e.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)
 
@@ -117,8 +117,16 @@ module Action = struct
     let map = `Define_using_bind
   end)
 
+  let ( let+ ) e f = map e ~f
   let ( let* ) e f = bind e ~f
   let ( and* ) = both
+
+  let rec repeat ?(n = 1) a =
+    match n with
+    | _ when n <= 0 -> return ()
+    | 1 -> a
+    | _ -> a *> repeat ~n:(n - 1) a
+
   let get e = (e, e)
   let put e _ = ((), e)
   let modify ~f e = ((), f e)
@@ -149,8 +157,22 @@ module Action = struct
     let* b = get_focused_buffer in
     return (f b |> fst)
 
+  let get_control_buffer e = (e.control, e)
+  let set_control_buffer c e = ((), { e with control = c })
+
+  let on_control_buffer f =
+    let* c = get_control_buffer in
+    set_control_buffer (f c)
+
   let get_mode e = (e.mode, e)
   let set_mode m e = ((), { e with mode = m })
+  let get_search_history e = (e.search_history, e)
+  let set_search_history h e = ((), { e with search_history = h })
+  let on_search_history f = get_search_history >>| f >>= set_search_history
+
+  let set_last_search dir word =
+    Zipper.(far_left &> swap_focus (dir, word)) |> on_search_history
+
   let get_terminal_size e = (e.term.size, e)
 
   let get_register ?(r = '"') e =
@@ -179,8 +201,14 @@ module Action = struct
         |> Text.extend ~fill r
         |> Fn.flip Sequence.take (r - ssize)
       in
-      let screen = Sequence.append bufview status in
-      Terminal.redraw screen e.cursor
+      let screen = Sequence.append bufview status
+      and cursor =
+        let open Mode in
+        match e.mode with
+        | Control -> (r, Control.cursor e.control)
+        | _ -> e.cursor
+      in
+      Terminal.redraw screen cursor
     in
     get >>| aux
 
@@ -189,7 +217,7 @@ module Action = struct
 
   (* Statusbar *)
   let set_message m e =
-    ((), { e with message = m; message_timestamp = Unix.time () })
+    ((), { e with message = Some 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 })
@@ -209,6 +237,15 @@ module Action = struct
     in
     get >>| check_message_timestamp >>= put
 
+  (* Control line *)
+  let search dir word =
+    let* coords = Buffer.Action.(search dir word |> on_focused_buffer) in
+    match coords with
+    | None ->
+        let word = word |> Sequence.to_list |> String.of_list in
+        set_message (Printf.sprintf "Pattern not found: %s" word)
+    | Some (r, c) -> Buffer.Action.goto r c |> on_focused_buffer
+
   (* Debug *)
   let get_rendered e = (e.rendered, e)
   let set_rendered r e = ((), { e with rendered = r })
@@ -448,7 +485,28 @@ let handle_normal_command c =
     | Shortcut (_, n, Join) ->
         let n = Option.(value ~default:2 n) in
         Buffer.Action.join_lines ~n |> on_focused_buffer
-    (* Quit *)
+    (* Control *)
+    | Simple (Key ':' as k) ->
+        let c = Control.create k in
+        set_control_buffer c *> set_mode Control
+    | Simple (Key '/' as k) ->
+        let c = Control.create k in
+        (Zipper.(far_left &> push (true, Sequence.empty)) |> on_search_history)
+        *> set_control_buffer c *> set_mode Control
+    | Simple (Key '?' as k) ->
+        let c = Control.create k in
+        (Zipper.(far_left &> push (false, Sequence.empty)) |> on_search_history)
+        *> set_control_buffer c *> set_mode Control
+    | Shortcut (_, n, Search) -> (
+        let* h = get_search_history in
+        match Zipper.focus h with
+        | None -> set_message "No search history"
+        | Some (dir, word) -> search dir word |> repeat ?n)
+    | Shortcut (_, n, Search_rev) -> (
+        let* h = get_search_history in
+        match Zipper.focus h with
+        | None -> set_message "No search history"
+        | Some (dir, word) -> search (not dir) word |> repeat ?n)
     | Simple (Ctrl 'Q') -> quit 0
     (* Misc *)
     | Simple (Key 'A') ->
@@ -467,7 +525,49 @@ let handle_normal_command c =
   in
   compute_action *> update_command_cue
 
+let handle_control_command =
+  let open Command in
+  let open Action in
+  function
+  | Simple Arrow_down ->
+      let* c = get_control_buffer in
+      if Control.is_search c then
+        let* () = Zipper.left |> on_search_history
+        and* h = get_search_history in
+        match Zipper.focus h with
+        | None -> noop
+        | Some (_, word) -> Control.set_content word |> on_control_buffer
+      else failwith "Control line command history unimplemented!"
+  | Simple Arrow_left -> Control.move_left |> on_control_buffer
+  | Simple Arrow_right -> Control.move_right |> on_control_buffer
+  | Simple Arrow_up ->
+      let* c = get_control_buffer in
+      if Control.is_search c then
+        let* () = Zipper.right |> on_search_history
+        and* h = get_search_history in
+        match Zipper.focus h with
+        | None -> noop
+        | Some (_, word) -> Control.set_content word |> on_control_buffer
+      else failwith "Control line command history unimplemented!"
+  | Simple Backspace -> Control.delete_before |> on_control_buffer
+  | Simple Delete -> Control.delete_after |> on_control_buffer
+  | Simple Enter -> (
+      let* () = set_mode Normal and* c = get_control_buffer in
+      match Control.get_result c with
+      | Search (dir, word) -> search dir word *> set_last_search dir word
+      | No_result -> noop)
+  | Simple Esc -> (
+      let* () = set_mode Normal and* c = get_control_buffer in
+      match Control.get_result c with
+      | Search _ -> Zipper.(far_left &> pop &> snd) |> on_search_history
+      | No_result -> noop)
+  | Simple Home -> Control.bol |> on_control_buffer
+  | Simple End -> Control.eol |> on_control_buffer
+  | Type k -> Control.insert k |> on_control_buffer
+  | _ -> noop
+
 let handle_next_command m e =
+  let open Mode in
   match m with
   | Insert -> (
       match Sequence.next e.istream with
@@ -477,7 +577,10 @@ let handle_next_command m e =
       match Sequence.next e.nstream with
       | None -> ((), e)
       | Some (h, t) -> handle_normal_command h { e with nstream = t })
-  | Control -> failwith "unimplemented"
+  | Control -> (
+      match Sequence.next e.istream with
+      | None -> ((), e)
+      | Some (h, t) -> handle_control_command h { e with istream = t })
 
 let handle_next_command =
   let open Action in
diff --git a/lib/editorBuffer.ml b/lib/editorBuffer.ml
index 52b1115..1f363ef 100644
--- a/lib/editorBuffer.ml
+++ b/lib/editorBuffer.ml
@@ -88,8 +88,10 @@ module Action = struct
   let ( let+ ) b f = map b ~f
   let get b = (b, b)
   let put b _ = ((), b)
-  let modify ~f = get >>= (put &> f)
-  let on_content f b = ((), { b with content = Result.map ~f b.content })
+  let modify ~f = get >>| f >>= put
+  let get_content b = (b.content, b)
+  let set_content c b = ((), { b with content = c })
+  let on_content f = get_content >>| Result.map ~f >>= set_content
 
   let on_content_with_output ~default f b =
     match b.content with
@@ -143,6 +145,11 @@ module Action = struct
     in
     (horizontal left, horizontal right)
 
+  let goto r c =
+    let change_content = Zipper.(goto r &> map_focus (goto c)) |> on_content
+    and change_rendered = Zipper.goto r |> on_rendered in
+    change_content *> change_rendered
+
   let bol ?(n = 0) = move_down ~n *> (map_focus far_left |> on_content)
   let eol ?(n = 0) = move_down ~n *> (map_focus far_right |> on_content)
 
@@ -374,6 +381,55 @@ module Action = struct
     in
     bind_n_times ~n (change_content *> change_rendered)
 
+  let search forward word =
+    let rec tails s =
+      match Sequence.next s with
+      | None -> Sequence.empty
+      | Some (_, t) -> Sequence.shift_right (tails t) s
+    and prefix p l =
+      match Sequence.(next p, next l) with
+      | Some (ph, pt), Some (lh, lt) when Char.(ph = lh) -> prefix pt lt
+      | None, _ -> true
+      | _ -> false
+    in
+    let search_line w l =
+      Sequence.findi ~f:(fun _ -> prefix w) (tails l) |> Option.map ~f:fst
+    in
+    let* b = get in
+    let cr, cc = cursor ~rendered:false b in
+    let* c = get_content in
+    match c with
+    | Error _ -> return None
+    | Ok c -> (
+        if forward then
+          match Sequence.next (Zipper.after c) with
+          | None -> return None
+          | Some (h, t) -> (
+              match Zipper.(h |> right |> after) |> search_line word with
+              | Some i -> return (Some (cr, cc + i + 1))
+              | None ->
+                  let f r z =
+                    z |> to_seq |> search_line word
+                    |> Option.map ~f:(fun c -> (cr + r + 1, c))
+                  in
+                  return (Sequence.find_mapi t ~f))
+        else
+          let word = Sequence.(word |> to_list_rev |> of_list) in
+          let wlen = Sequence.length word in
+          match Zipper.(c |> right |> before) |> Sequence.next with
+          | None -> return None
+          | Some (h, t) -> (
+              match h |> Zipper.before |> search_line word with
+              | Some i -> return (Some (cr, cc - wlen - i))
+              | None ->
+                  let f r z =
+                    let z = z |> far_right in
+                    let len = left_length z in
+                    z |> before |> search_line word
+                    |> Option.map ~f:(fun c -> (cr - r - 1, len - wlen - c))
+                  in
+                  return (Sequence.find_mapi t ~f)))
+
   (* let save_history_to ?(clear = true) r = () *)
 end
 
diff --git a/lib/mode.ml b/lib/mode.ml
new file mode 100644
index 0000000..86f76d5
--- /dev/null
+++ b/lib/mode.ml
@@ -0,0 +1,3 @@
+type t = Normal | Insert | Control
+
+let to_string = function Insert -> " I " | Normal -> " N " | Control -> " C "
diff --git a/lib/modes.ml b/lib/modes.ml
deleted file mode 100644
index 3d0e354..0000000
--- a/lib/modes.ml
+++ /dev/null
@@ -1,18 +0,0 @@
-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