Fix test suite for the git backend with the new architecture

src/file.ml

@@ -73,6 +73,31 @@ end
 
 module X = struct
 
+module Filenames = struct
+
+  let internal = "filenames"
+
+  type t = Filename.Set.t
+
+  let empty = Filename.Set.empty
+
+  let of_string f s =
+    let lines = Lines.of_string f s in
+    let lines = Utils.filter_map (function
+      | []  -> None
+      | [f] -> Some (Filename.of_string f)
+      | s   ->
+          Globals.error_and_exit "%S is not a valid filename" (String.concat " " s)
+    ) lines in
+    Filename.Set.of_list lines
+
+  let to_string f s =
+    let lines =
+      List.map (fun f -> [Filename.to_string f]) (Filename.Set.elements s) in
+    Lines.to_string f lines
+
+end
+
 module Urls_txt = struct
 
   let internal = "urls-txt"
@@ -1301,3 +1326,8 @@ module Urls_txt = struct
   include Urls_txt
   include Make(Urls_txt)
 end
+
+module Filenames = struct
+  include Filenames
+  include Make(Filenames)
+end

src/file.mli

@@ -378,3 +378,6 @@ end
 
 (** {2 urls.txt file *} *)
 module Urls_txt: IO_FILE with type t = (basename * int * string) list
+
+(** List of filenames *)
+module Filenames: IO_FILE with type t = Filename.Set.t

src/repo/curl.ml

@@ -113,7 +113,7 @@ module B = struct
     else begin
       let local_file = Filename.Map.find remote_file state.remote_local in
       if is_up_to_date state local_file then
-        Up_to_date
+        Up_to_date local_file
       else begin
         log "dowloading %s" (Filename.to_string remote_file);
         let local_dir = Filename.dirname local_file in

src/repo/git.ml

@@ -1,5 +1,4 @@
 open Types
-open Repo_helpers
 
 let log fmt = Globals.log "git" fmt
 
@@ -29,37 +28,90 @@ let git_diff local_path =
       Run.read_command_output
         [ "git" ; "diff" ; "remotes/origin/master" ; "--name-only" ]
     with
-    | Some fs -> fs
+    | Some fs -> Filename.Set.of_list (List.map Filename.of_string fs)
     | None    ->
         Globals.error_and_exit
           "Cannot diff git repository %s"
           (Dirname.to_string local_path)
   )
 
-let remote_diff state =
-  let fs = git_diff state.local_path in
-  Filename.Set.of_list (List.map ((//) state.remote_path) fs)
+let git_init local_path remote_path =
+  Dirname.mkdir local_path;
+  Dirname.in_dir local_path (fun () ->
+    let repo = Dirname.to_string remote_path in
+    let err =
+      Run.commands [
+        [ "git" ; "init" ] ;
+        [ "git" ; "remote" ; "add" ; "origin" ; repo ] ;
+      ] in
+    if err <> 0 then
+      Globals.error_and_exit "Cannot clone %s" repo
+  )
 
-module Repo = struct
+let check_updates local_path =
+  if Dirname.exists (local_path / ".git") then begin
+    git_fetch local_path;
+    let files = git_diff local_path in
+    git_merge local_path;
+    Some files
+  end else
+    None
 
-  (* The list of modified files *)
-  type t = Filename.Set.t
+module B = struct
 
-  let make state =
-    log "make_state";
-    if Dirname.exists (state.local_path / ".git") then begin
-      git_fetch state.local_path;
-      remote_diff state;
-    end else
-      Filename.Set.empty
+  let updates r =
+    Path.R.root r // "last-git-updates"
+
+  let init r =
+    let local_repo = Path.R.create r in
+    git_init (Path.R.root local_repo) (Repository.address r);
+    File.Filenames.write (updates local_repo) (Filename.Set.empty)
 
-  let sync state =
-    let diff = make state in
-    if not (Filename.Set.is_empty diff) then
-      git_merge state.local_path;
-    diff
+  let check_file r file =
+    let local_repo = Path.R.create r in
+    let updates = File.Filenames.read (updates local_repo) in
+    if Filename.Set.mem file updates then
+      Result file
+    else if Filename.exists file then
+      Up_to_date file
+    else
+      Not_available
+
+  let download_archive r nv =
+    let local_repo = Path.R.create r in
+    let archive = Path.R.archive local_repo nv in
+    check_file r archive
+
+  let download_file r nv filename =
+    let local_repo = Path.R.create r in
+    let basename = Filename.basename filename in
+    let file = Path.R.tmp_dir local_repo nv // Basename.to_string basename in
+    check_file r file
+
+  let rec download_dir r nv dirname =
+    let local_repo = Path.R.create r in
+    let basename = Dirname.basename dirname in
+    let dir = Path.R.tmp_dir local_repo nv / Basename.to_string basename in
+    match check_updates dir with
+    | None ->
+        git_init dir dirname;
+        download_dir r nv dirname
+    | Some f ->
+        if Filename.Set.empty = f then
+          Up_to_date dir
+        else
+          Result dir
+
+  let update r =
+    let local_path = Path.R.root (Path.R.create r) in
+    match check_updates local_path with
+    | Some f -> f
+    | None   ->
+        Globals.error_and_exit
+          "The repository %s is not initialized correctly"
+          (Repository.to_string r)
 
-  let upload state dirname =
+  let upload_dir state dirname =
     let files = Filename.rec_list dirname in
     let err = Run.commands [
       [ "git"; "add"; Dirname.to_string dirname; ];
@@ -73,5 +125,5 @@ module Repo = struct
 
 end
 
-module M = Repo_helpers.Make(Repo)
-include M
+let () =
+  Repositories.register_backend "git" (module B: Repositories.BACKEND)

src/repo/rsync.ml

@@ -21,7 +21,7 @@ let rsync ?(delete=true) src dst =
   with
   | None   -> Not_available
   | Some l -> match trim l with
-    | []    -> Up_to_date
+    | []    -> Up_to_date []
     | lines ->
         List.iter (fun f -> log "updated: %s %s" (Run.cwd ()) f) lines;
         Result lines
@@ -32,7 +32,7 @@ let rsync_dirs ?delete src dst =
   let dst_files0 = Filename.rec_list dst in
   match rsync ?delete src_s dst_s with
   | Not_available -> Not_available
-  | Up_to_date    -> Up_to_date
+  | Up_to_date _  -> Up_to_date dst
   | Result lines  ->
       let src_files = Filename.rec_list src in
       let dst_files = Filename.rec_list dst in
@@ -52,8 +52,8 @@ let rsync_file src dst =
   with
   | None   -> Not_available
   | Some l -> match trim l with
-    | []  -> Up_to_date
-    | [f] -> Result (Filename.of_string f)
+    | []  -> Up_to_date dst
+    | [x] -> assert (Filename.to_string dst = x); Result dst
     | l   ->
         Globals.error_and_exit
           "unknown rsync output: {%s}"
@@ -89,16 +89,16 @@ module B = struct
     let sync_dir fn =
       match rsync_dirs ~delete:true (fn remote_repo) (fn local_repo) with
       | Not_available
-      | Up_to_date -> Filename.Set.empty
-      | Result dir ->
+      | Up_to_date _ -> Filename.Set.empty
+      | Result dir   ->
           let files = Filename.rec_list dir in
           Filename.Set.of_list files in
     let archives =
       let available_packages = Path.R.available_packages local_repo in
       let updates = NV.Set.filter (fun nv ->
         match download_archive r nv with
         | Not_available -> true
-        | Up_to_date    -> false
+        | Up_to_date _  -> false
         | Result _      -> true
       ) available_packages in
       List.map (Path.R.archive local_repo) (NV.Set.elements updates) in
@@ -120,8 +120,8 @@ module B = struct
           Globals.error_and_exit "Cannot upload %s to %s"
             (Dirname.to_string local_dir)
             (Repository.to_string r)
-      | Up_to_date -> Filename.Set.empty
-      | Result dir ->
+      | Up_to_date _ -> Filename.Set.empty
+      | Result dir   ->
           let files = Filename.rec_list dir in
           Filename.Set.of_list files
     else