Commits

Anonymous committed 5167a02 Draft

.

Comments (0)

Files changed (2)

src/post_template.ml

 
       let cache_dir_files = get_cache_dir "files"
 
-      let get_sources_no_cache pd ~dest s_kind =
+      let cache_dir_repos = get_cache_dir "repos"
+
+
+      let get_sources_cache pd ~dest ~rkind ~dlfunc ~cachedir =
+(*
+        .
+
+        учитывать, что source = `Remote и s_kind = `Dir -- assert false
+*)
+( ignore pd ; ignore dest ; ignore rkind ; ignore dlfunc ; ignore cachedir ; failwith "qwe" )
+
+
+
+      let get_sources_no_cache pd ~dest ~s_download =
         let pkg_name = pd.p_pkg_name in
         let () = cachedbg "getting source of package %S without cache"
           pkg_name
         in
-        let {s_kind = _; s_base_name = _; s_download; s_extract} =
-          pd.p_source
+        let s_extract = pd.p_source.s_extract
         in
             (* let () = assert_dir dest in *)
-            let is_local_and_path =
+            let local_path =
               match s_download with
               | `Local path ->
                   let () = cachedbg "package %S is local, path %S"
                     pkg_name path
                   in
-                  `DLocal path
-              | `Remote dlfunc ->
+                  path
+              | `Remote (_kind, dlfunc) ->
                   let () = cachedbg "package %S is remote, downloading"
                     pkg_name
                   in
                   let path = dlfunc ~dl_dest:dest in
                   let () = cachedbg "package %S downloaded to %S"
                     pkg_name path in
-                  `DRemote path
+                  path
             in
-            let local_name =
-              match is_local_and_path with
-              | `DLocal p | `DRemote p -> p
+            let () = cachedbg "extracting %S to %S" local_path dest
             in
-            let () = cachedbg "extracting %S to %S" local_name dest
-            in
-            let r = s_extract ~path:local_name ~dest in
+            let extract_res = s_extract ~path:local_path ~dest in
             let () =
-              match is_local_and_path with
-              | `DRemote local_name ->
+              match s_download with
+              | `Remote (rkind, _) ->
                   begin
-                  match s_kind with
+                  match rkind with
                   | `File ->
-                      let () = cachedbg "package %S was remote, \
+                      let () = cachedbg "package %S was remote file, \
                                          cleaning local \
                                          downloaded file %S"
-                        pkg_name local_name
+                        pkg_name local_path
                       in
-                      Sys.remove local_name
+                      Sys.remove local_path
                   | `Dir | `Repo ->
-                      if r = local_name
+                      if extract_res = local_path
                       then
-                        let () = cachedbg "package %S was remote, but \
+                        let () = cachedbg "package %S was remote repo, but \
                                            extracted \
                                            to required dir %S, not cleaning"
-                          pkg_name r
+                          pkg_name extract_res
                         in
                         ()
                       else
-                        let () = cachedbg "package %S was remote, extracted \
+                        let () = cachedbg "package %S was remote repo, \
+                                           extracted \
                                            to \
                                            temporary dir %S, so cleaning it"
-                                   pkg_name local_name
+                                   pkg_name local_path
                         in
-                        Reb_sys.rm_rf local_name
+                        Reb_sys.rm_rf local_path
                   end
-              | `DLocal _local_name ->
+              | `Local _local_name ->
                   let () = cachedbg "package %S was local, not cleaning"
                     pkg_name
                   in
                   ()
             in
-              r
+              extract_res
 
 
       let get_sources pd ~dest =
         let pkg_name = pd.p_pkg_name in
         let () = cachedbg "getting sources of %S" pkg_name in
-        match pd.p_source.s_kind with
+        match pd.p_source.s_download with
         | `No -> failwith "no sources for package %S" pkg_name
-        | (`File | `Dir | `Repo) as s_kind ->
-            let _into_cache =
-              false
-            in
-              get_sources_no_cache pd ~dest s_kind
+        | (`Local _ | `Remote _) as s_download ->
+            let no_cache () = get_sources_no_cache pd ~dest ~s_download in
+            match s_download with
+            | `Local _ -> no_cache ()
+            | `Remote (rkind, dlfunc) ->
+                let cache_dir_opt =
+                  (match rkind with
+                   | `File -> !!cache_dir_files
+                   | `Repo -> !!cache_dir_repos
+                  )
+                in
+                  (match cache_dir_opt with
+                   | None -> no_cache ()
+                   | Some cachedir ->
+                       get_sources_cache pd ~dest ~rkind ~dlfunc ~cachedir
+                  )
 
     end
 

src/pre_template.ml

   | Reqs_static of pkg list
   | Reqs_dynamic of (unit -> pkg list)
 type action = (unit -> unit)
+type downloadfunc = (dl_dest:string (* directory *) -> string (* exact path *))
 type source =
-  { s_kind : [`File | `Dir | `Repo | `No]
-  ; s_base_name : string
+  { s_base_name : string
   ; s_download :
-      [ `Local of string
-      | `Remote of (dl_dest:string (* directory *) -> string (* exact path *))
+      [ `No
+      | `Local of string
+      | `Remote of [`File | `Repo] * downloadfunc
       ]
   ; s_extract : ( path:string (* exact path *) ->
                   dest:string (* somewhere in work dir *) ->
 
 
     let none =
-      { s_kind = `No
-      ; s_base_name = "NONE"
-      ; s_download = `Local "NONE"
+      { s_base_name = "NONE"
+      ; s_download = `No
       ; s_extract =
           (fun ~path ~dest ->
              ( ignore path
            else failwith "can't clone mercurial repository with command %s"
                   (Reb_sys.dump_argv argv)
       in
-      { s_kind = `Repo
-      ; s_base_name = last_component_of_uri repo
+      { s_base_name = last_component_of_uri repo
       ; s_download =
-          if is_local repo
+         (if is_local repo
           then
             `Local repo
           else
-            `Remote
+            let remote_repo d = `Remote (`Repo, d) in
+            remote_repo
             (fun ~dl_dest ->
                let () = dbg "Source.hg: download: cloning %S (rev %S) \
                              to %S without workcopy"
                in
                clone ~src:repo ~dest:dl_dest ~workcopy:false
             )
+         )
       ; s_extract =
           (fun ~path ~dest ->
              if path = dest
       ~funcname
 
     let local_tar_gz infn =
-      { s_kind = `File
-      ; s_base_name = last_component_of_uri infn
+      { s_base_name = last_component_of_uri infn
       ; s_download = `Local infn
       ; s_extract =
           do_local_tar_gz ~funcname:"Source.local_tar_gz"
       ~funcname
 
     let local_tar_bz2 infn =
-      { s_kind = `File
-      ; s_base_name = last_component_of_uri infn
+      { s_base_name = last_component_of_uri infn
       ; s_download = `Local infn
       ; s_extract =
           do_local_tar_bz2 ~funcname:"Source.local_tar_bz2"
       }
 
     let local_dir dir =
-      { s_kind = `Dir
-      ; s_base_name = last_component_of_uri dir
+      { s_base_name = last_component_of_uri dir
       ; s_download = `Local dir
       ; s_extract =
           (fun ~path ~dest ->
 
     let remote_archive ?hash ~unpack ~uri ~funcname =
       let base_name = last_component_of_uri uri in
-      { s_kind = `File
-      ; s_base_name = base_name
-      ; s_download = `Remote
+      { s_base_name = base_name
+      ; s_download = `Remote (`File,
           (fun ~dl_dest ->
              let outfn = dl_dest </> base_name in
              ( download ?hash ~uri ~funcname ~outfn
              ; outfn
              )
-          )
+          ))
       ; s_extract =
           (fun ~path ~dest ->
              unpack ~funcname ~path ~dest