Merge pull request #438 from ulugbekna/medium-refactor

Refactorings, reorganizations, and renamings

src/git-index/git_index.ml

@@ -1,6 +1,5 @@
 [@@@warning "-32"]
 
-open Stdlib
 module Bigarray = Bigarray_compat
 
 let io_buffer_size = 65536

src/git-unix/git_unix.ml

@@ -15,7 +15,6 @@
  *)
 
 module Bigarray = Bigarray_compat
-open Stdlib
 open Lwt.Infix
 
 let ( >>? ) x f =

src/git/cstruct_append.ml

@@ -7,8 +7,6 @@
    In this context, [t] can stores only 2 objects. We should extend the
    implementation to be more general but the trade-off is bad. *)
 
-open Stdlib
-
 let src = Logs.Src.create "git-cstruct-append"
 
 module Log = (val Logs.src_log src : Logs.LOG)

src/git/value.ml

@@ -15,8 +15,6 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-open Stdlib
-
 type 'hash t =
   | Blob of Blob.t
   | Commit of 'hash Commit.t

src/not-so-smart/capability.ml

@@ -1,5 +1,3 @@
-open Stdlib
-
 type t =
   [ `Multi_ack
   | `Multi_ack_detailed

src/not-so-smart/dune

@@ -17,6 +17,12 @@
  (modules sigs)
  (libraries fmt cstruct))
 
+(library
+ (name smart_flow)
+ (public_name git.nss.smart-flow)
+ (modules smart_flow)
+ (libraries cstruct fmt git.nss.sigs git.nss.smart logs))
+
 (library
  (name hkt)
  (public_name git.nss.hkt)
@@ -27,7 +33,8 @@
  (name neg)
  (public_name git.nss.neg)
  (modules neg find_common default)
- (libraries stdlib-shims fmt rresult cstruct sigs logs psq smart))
+ (libraries stdlib-shims fmt rresult cstruct sigs logs psq smart
+   git.nss.smart-flow))
 
 (library
  (name pck)
@@ -39,7 +46,8 @@
  (name nss)
  (public_name git.nss)
  (modules nss fetch push)
- (libraries fmt result rresult logs ipaddr domain-name smart sigs neg pck))
+ (libraries fmt result rresult logs ipaddr domain-name smart sigs neg pck
+   git.nss.smart-flow))
 
 (library
  (name unixiz)
@@ -51,7 +59,7 @@
 (library
  (name smart_git)
  (public_name git.nss.git)
- (modules smart_git)
+ (modules smart_git smart_git_intf)
  (libraries mimic mirage-flow unixiz ipaddr decompress.de decompress.zl
    cstruct logs astring result rresult bigstringaf fmt emile lwt domain-name
    uri sigs smart pck nss digestif carton carton-lwt))

src/not-so-smart/fetch.ml

@@ -29,9 +29,8 @@ module Make
 struct
   open Scheduler
 
-  let src = Logs.Src.create "fetch"
-
-  module Log = (val Logs.src_log src : Logs.LOG)
+  module Log = (val let src = Logs.Src.create "fetch" in
+                    Logs.src_log src : Logs.LOG)
 
   let ( >>= ) x f = IO.bind x f
   let return x = IO.return x
@@ -100,7 +99,8 @@ struct
     let ctx = Smart.Context.make capabilities in
     let negotiator = Neg.make ~compare:Uid.compare in
     Neg.tips sched access store negotiator |> prj >>= fun () ->
-    Neg.run sched fail io flow (prelude ctx) |> prj >>= fun (uids, refs) ->
+    Smart_flow.run sched fail io flow (prelude ctx) |> prj
+    >>= fun (uids, refs) ->
     let hex =
       { Neg.to_hex = Uid.to_hex; of_hex = Uid.of_hex; compare = Uid.compare }
     in
@@ -113,17 +113,17 @@ struct
         let pack ctx =
           let open Smart in
           let side_band =
-            Smart.Context.is_cap_shared `Side_band ctx
-            || Smart.Context.is_cap_shared `Side_band_64k ctx
+            Smart.Context.is_cap_shared ctx `Side_band
+            || Smart.Context.is_cap_shared ctx `Side_band_64k
           in
           recv ctx
             (recv_pack ~side_band ~push_stdout ~push_stderr ~push_pack:pack)
         in
         if res < 0 then Log.warn (fun m -> m "No common commits");
         let rec go () =
           Log.debug (fun m -> m "Read PACK file.");
-          Neg.run sched fail io flow (pack ctx) |> prj >>= fun continue ->
-          if continue then go () else return ()
+          Smart_flow.run sched fail io flow (pack ctx) |> prj
+          >>= fun continue -> if continue then go () else return ()
         in
         Log.debug (fun m -> m "Start to download PACK file.");
         go () >>= fun () -> return (List.combine refs uids)

src/not-so-smart/find_common.ml

@@ -1,64 +1,16 @@
 open Sigs
-open Stdlib
+open Smart_flow
 
 let ( <.> ) f g x = f (g x)
-let src = Logs.Src.create "find-common"
 
-module Log = (val Logs.src_log src : Logs.LOG)
+module Log = (val let src = Logs.Src.create "find-common" in
+                  Logs.src_log src : Logs.LOG)
 
 let _initial_flush = 16
 let _max_in_vain = 256
 let _large_flush = 16384
 let _pipe_safe_flush = 32
 
-type ('a, 's) raise = exn -> ('a, 's) io
-
-let io_buffer_size = 65536
-
-let run :
-    type f s.
-    s scheduler ->
-    ('a, s) raise ->
-    (f, 'error, s) flow ->
-    f ->
-    ('res, [ `Protocol of Smart.error ]) Smart.t ->
-    ('res, s) io =
- fun { bind; return } raise { recv; send; pp_error } flow fiber ->
-  let ( >>= ) = bind in
-  let tmp = Cstruct.create io_buffer_size in
-  let failwithf fmt = Format.kasprintf (fun err -> raise (Failure err)) fmt in
-  let rec go = function
-    | Smart.Read { k; buffer; off; len; eof } -> (
-        let max = min (Cstruct.len tmp) len in
-        Log.debug (fun m -> m "Start to read %d byte(s)." max);
-        recv flow (Cstruct.sub tmp 0 max) >>= function
-        | Ok `End_of_flow ->
-            Log.debug (fun m -> m "Got end of input.");
-            go (eof ())
-        | Ok (`Input len) ->
-            Log.debug (fun m -> m "Got %d/%d byte(s)." len max);
-            Cstruct.blit_to_bytes tmp 0 buffer off len;
-            go (k len)
-        | Error err ->
-            Log.err (fun m -> m "Got an error: %a." pp_error err);
-            failwithf "%a" pp_error err)
-    | Smart.Write { k; buffer; off; len } ->
-        let rec loop tmp =
-          if Cstruct.len tmp = 0 then go (k len)
-          else
-            send flow tmp >>= function
-            | Ok shift -> loop (Cstruct.shift tmp shift)
-            | Error err -> failwithf "%a" pp_error err
-        in
-        Log.debug (fun m -> m "Write %d byte(s)." len);
-        loop (Cstruct.of_string buffer ~off ~len)
-    | Smart.Return v -> return v
-    | Smart.Error (`Protocol err) ->
-        Log.err (fun m -> m "Got a protocol error: %a." Smart.pp_error err);
-        failwithf "%a" Smart.pp_error err
-  in
-  go fiber
-
 (* XXX(dinosaure): this part is really **ugly**! But we must follow the same
    behaviour of [git]. Instead to understand the synchronisation process of [git]
    with Smart.v1 and implement a state of the art synchronisation algorithm, I

src/not-so-smart/neg.ml

@@ -1,5 +1,3 @@
-type nonrec ('a, 's) raise = ('a, 's) Find_common.raise
-
 type nonrec configuration = Find_common.configuration = {
   stateless : bool;
   mutable multi_ack : [ `None | `Some | `Detailed ];
@@ -15,6 +13,5 @@ type nonrec 'uid hex = 'uid Find_common.hex = {
 type 'uid negotiator = 'uid Default.t
 
 let make ~compare = Default.make ~compare
-let run = Find_common.run
 let find_common = Find_common.find_common
 let tips = Find_common.tips

src/not-so-smart/neg.mli

@@ -31,19 +31,10 @@ type 'uid hex = {
   compare : 'uid -> 'uid -> int;
 }
 
-type ('a, 's) raise = exn -> ('a, 's) io
 type 'uid negotiator
 
 val make : compare:('uid -> 'uid -> int) -> 'uid negotiator
 
-val run :
-  's scheduler ->
-  ('res, 's) raise ->
-  ('flow, 'error, 's) flow ->
-  'flow ->
-  ('res, [ `Protocol of Smart.error ]) Smart.t ->
-  ('res, 's) io
-
 val find_common :
   's scheduler ->
   ('flow, 'error, 's) flow ->

src/not-so-smart/protocol.ml

@@ -1,7 +1,5 @@
 let ( <.> ) f g x = f (g x)
 
-open Stdlib
-
 module Advertised_refs = struct
   type ('uid, 'reference) t = {
     shallows : 'uid list;
@@ -859,12 +857,11 @@ module Encoder = struct
     in
     delayed_write_pkt k kdone encoder
 
-  let unsafe_encode_packet encoder ~packet =
-    let pos = encoder.pos in
-    encoder.pos <- encoder.pos + 4;
+  let unsafe_encode_packet ({ pos; payload; _ } as encoder) ~packet =
+    encoder.pos <- pos + 4;
     write encoder packet;
     let len = encoder.pos - pos in
-    Bytes.blit_string (Fmt.str "%04X" len) 0 encoder.payload pos 4
+    Bytes.blit_string (Fmt.str "%04X" len) 0 payload pos 4
 
   let write_command encoder = function
     | Commands.Create (uid, r) ->

src/not-so-smart/push.ml

@@ -39,12 +39,12 @@ struct
         pp_error = Flow.pp_error;
       }
 
-  let push ?(prelude = true) ~capabilities:caps cmds ~host path flow store
-      access push_cfg pack =
+  let push ?(uses_git_transport = true) ~capabilities:caps cmds ~host path flow
+      store access push_cfg pack =
     let fiber ctx =
       let open Smart in
       let* () =
-        if prelude then
+        if uses_git_transport then
           send ctx proto_request
             (Proto_request.receive_pack ~host ~version:1 path)
         else return ()
@@ -54,18 +54,19 @@ struct
       return (Smart.Advertised_refs.map ~fuid:Uid.of_hex ~fref:Ref.v v)
     in
     let ctx = Smart.Context.make caps in
-    Neg.run sched fail io flow (fiber ctx) |> prj >>= fun advertised_refs ->
+    Smart_flow.run sched fail io flow (fiber ctx) |> prj
+    >>= fun advertised_refs ->
     Pck.commands sched
       ~capabilities:(Smart.Advertised_refs.capabilities advertised_refs)
       ~equal:Ref.equal ~deref:access.Sigs.deref store cmds
       (Smart.Advertised_refs.refs advertised_refs)
     |> prj
     >>= function
     | None ->
-        Neg.run sched fail io flow Smart.(send ctx flush ()) |> prj
+        Smart_flow.run sched fail io flow Smart.(send ctx flush ()) |> prj
         >>= fun () -> return ()
     | Some cmds -> (
-        Neg.run sched fail io flow
+        Smart_flow.run sched fail io flow
           Smart.(
             send ctx commands
               (Commands.map ~fuid:Uid.to_hex ~fref:Ref.to_string cmds))
@@ -84,27 +85,28 @@ struct
             m "Prepare a pack of %d object(s)." (List.length uids));
         let stream = pack uids in
         let side_band =
-          Smart.Context.is_cap_shared `Side_band ctx
-          || Smart.Context.is_cap_shared `Side_band_64k ctx
+          Smart.Context.is_cap_shared ctx `Side_band
+          || Smart.Context.is_cap_shared ctx `Side_band_64k
         in
         let pack = Smart.send_pack ~stateless:push_cfg.stateless side_band in
         let rec go () =
           stream () >>= function
           | None ->
               let report_status =
-                Smart.Context.is_cap_shared `Report_status ctx
+                Smart.Context.is_cap_shared ctx `Report_status
               in
               Log.debug (fun m ->
                   m "report-status capability: %b." report_status);
               if report_status then
-                Neg.run sched fail io flow Smart.(recv ctx status)
+                Smart_flow.run sched fail io flow Smart.(recv ctx status)
                 |> prj
                 >>| Smart.Status.map ~f:Ref.v
               else
                 let cmds = List.map R.ok (Smart.Commands.commands cmds) in
                 return (Smart.Status.v cmds)
           | Some payload ->
-              Neg.run sched fail io flow Smart.(send ctx pack payload) |> prj
+              Smart_flow.run sched fail io flow Smart.(send ctx pack payload)
+              |> prj
               >>= fun () -> go ()
         in
         go () >>= fun status ->

src/not-so-smart/push.mli

@@ -11,7 +11,7 @@ module Make
     (Uid : UID)
     (Ref : REF) : sig
   val push :
-    ?prelude:bool ->
+    ?uses_git_transport:bool ->
     capabilities:Smart.Capability.t list ->
     [ `Create of Ref.t | `Delete of Ref.t | `Update of Ref.t * Ref.t ] list ->
     host:[ `Addr of Ipaddr.t | `Domain of [ `host ] Domain_name.t ] ->

src/not-so-smart/smart.ml

@@ -53,9 +53,9 @@ module Value = struct
   let encode :
       type a. encoder -> a send -> a -> (unit, [> Encoder.error ]) State.t =
    fun encoder w v ->
-    let fiber : a send -> [> Encoder.error ] Encoder.state =
+    let encoder_state =
       let open Protocol.Encoder in
-      function
+      match w with
       | Proto_request -> encode_proto_request encoder v
       | Want -> encode_want encoder v
       | Done -> encode_done encoder
@@ -65,32 +65,37 @@ module Value = struct
       | Flush -> encode_flush encoder
       | Advertised_refs -> encode_advertised_refs encoder v
     in
-    let rec go = function
+    let rec translate_to_state_t = function
       | Encoder.Done -> State.Return ()
       | Write { continue; buffer; off; len } ->
-          State.Write { k = go <.> continue; buffer; off; len }
+          State.Write
+            { k = translate_to_state_t <.> continue; buffer; off; len }
       | Error err -> State.Error (err :> error)
     in
-    (go <.> fiber) w
+    translate_to_state_t encoder_state
 
   let decode : type a. decoder -> a recv -> (a, [> Decoder.error ]) State.t =
    fun decoder w ->
-    let rec go = function
+    let rec transl :
+        (a, [> Protocol.Decoder.error ]) Decoder.state ->
+        (a, [> Decoder.error ]) State.t = function
       | Decoder.Done v -> State.Return v
       | Read { buffer; off; len; continue; eof } ->
-          State.Read { k = go <.> continue; buffer; off; len; eof = go <.> eof }
+          State.Read
+            { k = transl <.> continue; buffer; off; len; eof = transl <.> eof }
       | Error { error; _ } -> State.Error error
     in
-    let open Protocol.Decoder in
-    match w with
-    | Advertised_refs -> go (decode_advertised_refs decoder)
-    | Result -> go (decode_result decoder)
-    | Recv_pack { side_band; push_pack; push_stdout; push_stderr } ->
-        go (decode_pack ~side_band ~push_pack ~push_stdout ~push_stderr decoder)
-    | Ack -> go (decode_negotiation decoder)
-    | Status -> go (decode_status decoder)
-    | Shallows -> go (decode_shallows decoder)
-    | Packet trim -> go (decode_packet ~trim decoder)
+    transl
+      (let open Protocol.Decoder in
+      match w with
+      | Advertised_refs -> decode_advertised_refs decoder
+      | Result -> decode_result decoder
+      | Recv_pack { side_band; push_pack; push_stdout; push_stderr } ->
+          decode_pack ~side_band ~push_pack ~push_stdout ~push_stderr decoder
+      | Ack -> decode_negotiation decoder
+      | Status -> decode_status decoder
+      | Shallows -> decode_shallows decoder
+      | Packet trim -> decode_packet ~trim decoder)
 end
 
 type ('a, 'err) t = ('a, 'err) State.t =