diff --git a/bin/command.ml b/bin/command.ml index eb59ad8..2ddb068 100644 --- a/bin/command.ml +++ b/bin/command.ml @@ -2,7 +2,8 @@ type t = [ | `Mark of string | `Unmark of string | `Unmark_all - | `Drop_path of string + | `Drop of string + | `Drop_all_except of string | `Drop_marked | `Drop_unmarked | `Drop_listed @@ -17,7 +18,8 @@ let pp fmt (t : t) = | `Mark s -> Fmt.pf fmt "mark: %s" s | `Unmark s -> Fmt.pf fmt "unmark: %s" s | `Unmark_all -> Fmt.pf fmt "unmark all" - | `Drop_path s -> Fmt.pf fmt "drop path: %s" s + | `Drop s -> Fmt.pf fmt "drop: %s" s + | `Drop_all_except s -> Fmt.pf fmt "drop all except: %s" s | `Drop_marked -> Fmt.pf fmt "drop marked" | `Drop_unmarked -> Fmt.pf fmt "drop unmarked" | `Drop_listed -> Fmt.pf fmt "drop listed" @@ -64,9 +66,11 @@ module Parsers = struct ); string "drop" *> skip_spaces *> ( choice [ - string "path" *> skip_spaces *> char ':' *> skip_spaces *> - any_string_trimmed >>| (fun s -> (`Drop_path s)); + any_string_trimmed >>| (fun s -> (`Drop s)); + string "all" *> skip_spaces *> + string "except" *> skip_spaces *> char ':' *> skip_spaces *> + any_string_trimmed >>| (fun s -> (`Drop_all_except s)); string "listed" *> skip_spaces *> return `Drop_listed; string "unlisted" *> skip_spaces *> return `Drop_unlisted; string "marked" *> skip_spaces *> return `Drop_marked; @@ -103,7 +107,8 @@ let of_string (s : string) : t option = let equal (x : t) (y : t) = match x, y with - | `Drop_path x, `Drop_path y -> String.equal x y + | `Drop x, `Drop y -> String.equal x y + | `Drop_all_except x, `Drop_all_except y -> String.equal x y | `Drop_listed, `Drop_listed -> true | `Drop_unlisted, `Drop_unlisted -> true | `Narrow_level x, `Narrow_level y -> Int.equal x y diff --git a/bin/docfd.ml b/bin/docfd.ml index 4366d88..352df23 100644 --- a/bin/docfd.ml +++ b/bin/docfd.ml @@ -912,7 +912,8 @@ let run Fmt.str "# - %a" Command.pp (`Mark "/path/to/document"); Fmt.str "# - %a" Command.pp (`Unmark "/path/to/document"); Fmt.str "# - %a" Command.pp `Unmark_all; - Fmt.str "# - %a" Command.pp (`Drop_path "/path/to/document"); + Fmt.str "# - %a" Command.pp (`Drop "/path/to/document"); + Fmt.str "# - %a" Command.pp (`Drop_all_except "/path/to/document"); Fmt.str "# - %a" Command.pp `Drop_marked; Fmt.str "# - %a" Command.pp `Drop_unmarked; Fmt.str "# - %a" Command.pp `Drop_listed; diff --git a/bin/document_store.ml b/bin/document_store.ml index 1889308..818405c 100644 --- a/bin/document_store.ml +++ b/bin/document_store.ml @@ -264,7 +264,16 @@ let toggle_mark ~path t = let unmark_all t = {t with documents_marked = String_set.empty } -let drop (choice : [ `Path of string | `Marked | `Unmarked | `Usable | `Unusable ]) (t : t) : t = +let drop + (choice : + [ `Path of string + | `All_except of string + | `Marked + | `Unmarked + | `Usable + | `Unusable ]) + (t : t) + : t = let aux ~(keep : string -> bool) = let keep' : 'a. string -> 'a -> bool = fun path _ -> @@ -292,6 +301,12 @@ let drop (choice : [ `Path of string | `Marked | `Unmarked | `Usable | `Unusable search_results = String_map.remove path t.search_results; } ) + | `All_except path -> ( + let keep path' = + String.equal path' path + in + aux ~keep + ) | `Marked -> ( let keep path = not (String_set.mem path t.documents_marked) @@ -377,9 +392,12 @@ let run_command pool (command : Command.t) (t : t) : t option = | `Unmark_all -> ( Some (unmark_all t) ) - | `Drop_path s -> ( + | `Drop s -> ( Some (drop (`Path s) t) ) + | `Drop_all_except s -> ( + Some (drop (`All_except s) t) + ) | `Drop_marked -> ( Some (drop `Marked t) ) diff --git a/bin/document_store.mli b/bin/document_store.mli index 0ddedeb..ece7e1b 100644 --- a/bin/document_store.mli +++ b/bin/document_store.mli @@ -60,7 +60,7 @@ val toggle_mark : path:string -> t -> t val unmark_all : t -> t -val drop : [ `Path of string | `Marked | `Unmarked | `Usable | `Unusable ] -> t -> t +val drop : [ `Path of string | `All_except of string | `Marked | `Unmarked | `Usable | `Unusable ] -> t -> t val narrow_search_scope : level:int -> t -> t diff --git a/bin/ui.ml b/bin/ui.ml index 50b3684..dc7f3e3 100644 --- a/bin/ui.ml +++ b/bin/ui.ml @@ -171,13 +171,17 @@ let unmark_all () = in Document_store_manager.submit_update_req new_snapshot -let drop ~document_count (choice : [`Path of string | `Marked | `Unmarked | `Listed | `Unlisted]) = +let drop ~document_count (choice : [`Path of string | `All_except of string | `Marked | `Unmarked | `Listed | `Unlisted]) = let choice, new_command = match choice with | `Path path -> ( let n = Lwd.peek Vars.index_of_document_selected in set_document_selected ~choice_count:(document_count - 1) n; - (`Path path, `Drop_path path) + (`Path path, `Drop path) + ) + | `All_except path -> ( + set_document_selected ~choice_count:1 0; + (`All_except path, `Drop_all_except path) ) | `Marked -> ( reset_document_selected ();