X-Git-Url: https://git.xandkar.net/?p=dups.git;a=blobdiff_plain;f=dups.ml;h=ba1fb0c21a6e8afb33b6e4587dcc5082510f3490;hp=8a555e8246b908c9a90ca1b1de43518633fb7933;hb=e4a6d3c94cc9f640d6f7d1123a86a3906b458492;hpb=03db9aee3a879fdb6aef6b40d86b9aca3898a376

diff --git a/dups.ml b/dups.ml
index 8a555e8..ba1fb0c 100644
--- a/dups.ml
+++ b/dups.ml
@@ -2,22 +2,51 @@ open Printf
 
 module Array = ArrayLabels
 module List  = ListLabels
+module StrSet= Set.Make(String)
 
 module Stream : sig
   type 'a t
-  val lines : in_channel -> string t
-  val rec_file_paths : root:string -> string t
+
+  val create : (unit -> 'a option) -> 'a t
+
   val iter : 'a t -> f:('a -> unit) -> unit
+
+  val concat : ('a t) list -> 'a t
 end = struct
   module S = Stream
 
   type 'a t =
-    'a S.t
+    ('a S.t) list
 
-  let rec_file_paths ~root =
+  let create f =
+    [S.from (fun _ -> f ())]
+
+  let iter t ~f =
+    List.iter t ~f:(S.iter f)
+
+  let concat ts =
+    List.concat ts
+end
+
+module In_channel : sig
+  val lines : in_channel -> string Stream.t
+end = struct
+  let lines ic =
+    Stream.create (fun () ->
+      match input_line ic with
+      | exception End_of_file ->
+          None
+      | line ->
+          Some line
+    )
+end
+
+module Directory_tree : sig
+  val find_files : string -> string Stream.t
+end = struct
+  let find_files root =
     let dirs  = Queue.create () in
     let files = Queue.create () in
-    Queue.add root dirs;
     let explore parent =
       Array.iter (Sys.readdir parent) ~f:(fun child ->
         let path = Filename.concat parent child in
@@ -35,47 +64,30 @@ end = struct
             ()
       )
     in
-    let next_dir () =
-      match Queue.take dirs with
-      | exception Queue.Empty ->
-          ()
-      | dir ->
-          explore dir
-    in
-    let next_file () =
-      match Queue.take files with
-      | exception Queue.Empty ->
-          None
-      | file_path ->
-          Some file_path
+    explore root;
+    let rec next () =
+      match Queue.is_empty files, Queue.is_empty dirs with
+      | false, _     -> Some (Queue.take files)
+      | true , true  -> None
+      | true , false ->
+          explore (Queue.take dirs);
+          next ()
     in
-    S.from (fun _ ->
-      next_dir ();
-      next_file ()
-    )
-
-  let lines ic =
-    S.from (fun _ ->
-      match input_line ic with
-      | exception End_of_file ->
-          None
-      | line ->
-          Some line
-    )
-
-  let iter t ~f =
-    S.iter f t
+    Stream.create next
 end
 
 type input =
-  | Root_path of string
+  | Root_paths of string list
   | Paths_on_stdin
 
 let main input =
   let paths =
     match input with
-    | Paths_on_stdin -> Stream.lines stdin
-    | Root_path root -> Stream.rec_file_paths ~root
+    | Paths_on_stdin ->
+        In_channel.lines stdin
+    | Root_paths paths ->
+        let paths = StrSet.elements (StrSet.of_list paths) in
+        Stream.concat (List.map paths ~f:Directory_tree.find_files)
   in
   let paths_by_digest = Hashtbl.create 1_000_000 in
   let path_count = ref 0 in
@@ -87,20 +99,20 @@ let main input =
       let paths =
         match Hashtbl.find_opt paths_by_digest digest with
         | None ->
-            []
+            StrSet.empty
         | Some paths ->
             paths
       in
-      Hashtbl.replace paths_by_digest digest (path :: paths)
+      Hashtbl.replace paths_by_digest digest (StrSet.add path paths)
     with Sys_error e ->
       eprintf "WARNING: Failed to process %S: %S\n%!" path e
   );
   Hashtbl.iter
     (fun digest paths ->
-      let n_paths = List.length paths in
+      let n_paths = StrSet.cardinal paths in
       if n_paths > 1 then begin
         printf "%s %d\n%!" (Digest.to_hex digest) n_paths;
-        List.iter paths ~f:(fun path -> printf "    %s\n%!" path)
+        List.iter (StrSet.elements paths) ~f:(printf "    %S\n%!")
       end
     )
     paths_by_digest;
@@ -109,5 +121,19 @@ let main input =
 
 let () =
   let input = ref Paths_on_stdin in
-  Arg.parse [] (fun path -> input := Root_path path) "";
+  Arg.parse
+    []
+    (function
+    | path when Sys.file_exists path ->
+        (match !input with
+        | Paths_on_stdin ->
+            input := Root_paths [path]
+        | Root_paths paths ->
+            input := Root_paths (path :: paths)
+        )
+    | path ->
+        eprintf "File does not exist: %S\n%!" path;
+        exit 1
+    )
+    "";
   main !input