<commit_before>module Default =
struct
  let default =
    [ `Multi_ack_detailed
    ; `Thin_pack
    ; `Side_band_64k
    ; `Ofs_delta
    ; `Agent "git/2.0.0"
    ; `Report_status
    ; `No_done ]
end

module Option =
struct
  let mem v x ~equal = match v with Some x' -> equal x x' | None -> false
  let value_exn v ~error = match v with Some v -> v | None -> raise (Invalid_argument error)
end

module Net =
struct
  module Log =
  struct
    let src = Logs.Src.create "git-tcp.net" ~doc:"logs git's net I/O event"
    include (val Logs.src_log src : Logs.LOG)
  end

  type socket = Lwt_unix.file_descr

  let read = Lwt_unix.read
  let write = Lwt_unix.write
  let close = Lwt_unix.close

  let socket host port =
    let open Lwt.Infix in

    Log.debug (fun l -> l ~header:"socket" "Start to open connection on %s:%d." host port);

    let socket = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_STREAM 0 in
    Lwt_unix.gethostbyname host >>= fun he ->
    Lwt_unix.connect socket (Unix.ADDR_INET (he.Unix.h_addr_list.(0), port)) >|= fun () -> socket
end

module Make
    (K : Git.Sync.CAPABILITIES)
    (S : Git.Minimal.S
           with type Hash.Digest.buffer = Cstruct.t
            and type Hash.hex = string)
= struct
  include Git.Sync.Make(Net)(S)(K)

  type error' =
    [ `StoreRef of S.Ref.error
    | `Sync of error ]

  module Negociator = Git.Negociator.Make(S)

  module Log =
  struct
    let src = Logs.Src.create "git-tcp" ~doc:"logs git's tcp event"
    include (val Logs.src_log src : Logs.LOG)
  end

  exception Jump of S.Ref.error

  let fetch_all t ?locks repository =
    let open Lwt.Infix in

    Negociator.find_common t >>= fun (has, state, continue) ->
    let continue { Client.Decoder.acks; shallow; unshallow } state =
      continue { Git.Negociator.acks; shallow; unshallow } state
    in

    let want refs =
      Lwt_list.filter_map_p
        (function (hash, refname, false) ->
           let reference = S.Reference.of_string refname in
           Lwt.return (Some (reference, hash))
                | _ -> Lwt.return None)
        refs
    in

    let notify _ = Lwt.return () in

    let host = Option.value_exn (Uri.host repository) ~error:(Fmt.strf "Expected a git url with host: %a." Uri.pp_hum repository) in
    let _ =
      if not (Option.mem (Uri.scheme repository) "git" ~equal:String.equal)
      then raise (Invalid_argument "Expected a git url");
    in

    let open Lwt_result in
    let ( >!= ) = Lwt_result.bind_lwt_err in

    fetch t ?port:(Uri.port repository) ~notify ~negociate:(continue, state) ~has ~want host (Uri.path_and_query repository)
    >!= (fun err -> Lwt.return (`Sync err))
    >>= fun (lst, _) ->
    Lwt.catch
      (fun () ->
         let open Lwt.Infix in
         Lwt_list.iter_s
           (fun (reference, hash) ->
              Log.debug (fun l -> l ~header:"fetch_all" "Update reference %a to %a."
                            S.Reference.pp reference S.Hash.pp hash);

              S.Ref.write t ?locks reference (S.Reference.Hash hash) >>= function
              | Ok _ -> Lwt.return ()
              | Error err -> Lwt.fail (Jump err))
           lst >>= fun () -> Lwt.return (Ok ()))
      (function Jump err -> Lwt.return (Error (`StoreRef err)))

  let fetch_one t ?locks ~reference repository =
    let open Lwt.Infix in

    Negociator.find_common t >>= fun (has, state, continue) ->
    let continue { Client.Decoder.acks; shallow; unshallow } state =
      continue { Git.Negociator.acks; shallow; unshallow } state
    in<commit_msg>Fixed warning about exhaustive pattern-matching on the git-tcp-unix package<commit_after>module Default =
struct
  let default =
    [ `Multi_ack_detailed
    ; `Thin_pack
    ; `Side_band_64k
    ; `Ofs_delta
    ; `Agent "git/2.0.0"
    ; `Report_status
    ; `No_done ]
end

module Option =
struct
  let mem v x ~equal = match v with Some x' -> equal x x' | None -> false
  let value_exn v ~error = match v with Some v -> v | None -> raise (Invalid_argument error)
end

module Net =
struct
  module Log =
  struct
    let src = Logs.Src.create "git-tcp.net" ~doc:"logs git's net I/O event"
    include (val Logs.src_log src : Logs.LOG)
  end

  type socket = Lwt_unix.file_descr

  let read = Lwt_unix.read
  let write = Lwt_unix.write
  let close = Lwt_unix.close

  let socket host port =
    let open Lwt.Infix in

    Log.debug (fun l -> l ~header:"socket" "Start to open connection on %s:%d." host port);

    let socket = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_STREAM 0 in
    Lwt_unix.gethostbyname host >>= fun he ->
    Lwt_unix.connect socket (Unix.ADDR_INET (he.Unix.h_addr_list.(0), port)) >|= fun () -> socket
end

module Make
    (K : Git.Sync.CAPABILITIES)
    (S : Git.Minimal.S
           with type Hash.Digest.buffer = Cstruct.t
            and type Hash.hex = string)
= struct
  include Git.Sync.Make(Net)(S)(K)

  type error' =
    [ `StoreRef of S.Ref.error
    | `Sync of error ]

  module Negociator = Git.Negociator.Make(S)

  module Log =
  struct
    let src = Logs.Src.create "git-tcp" ~doc:"logs git's tcp event"
    include (val Logs.src_log src : Logs.LOG)
  end

  exception Jump of S.Ref.error

  let fetch_all t ?locks repository =
    let open Lwt.Infix in

    Negociator.find_common t >>= fun (has, state, continue) ->
    let continue { Client.Decoder.acks; shallow; unshallow } state =
      continue { Git.Negociator.acks; shallow; unshallow } state
    in

    let want refs =
      Lwt_list.filter_map_p
        (function (hash, refname, false) ->
           let reference = S.Reference.of_string refname in
           Lwt.return (Some (reference, hash))
                | _ -> Lwt.return None)
        refs
    in

    let notify _ = Lwt.return () in

    let host = Option.value_exn (Uri.host repository) ~error:(Fmt.strf "Expected a git url with host: %a." Uri.pp_hum repository) in
    let _ =
      if not (Option.mem (Uri.scheme repository) "git" ~equal:String.equal)
      then raise (Invalid_argument "Expected a git url");
    in

    let open Lwt_result in
    let ( >!= ) = Lwt_result.bind_lwt_err in

    fetch t ?port:(Uri.port repository) ~notify ~negociate:(continue, state) ~has ~want host (Uri.path_and_query repository)
    >!= (fun err -> Lwt.return (`Sync err))
    >>= fun (lst, _) ->
    Lwt.catch
      (fun () ->
         let open Lwt.Infix in
         Lwt_list.iter_s
           (fun (reference, hash) ->
              Log.debug (fun l -> l ~header:"fetch_all" "Update reference %a to %a."
                            S.Reference.pp reference S.Hash.pp hash);

              S.Ref.write t ?locks reference (S.Reference.Hash hash) >>= function
              | Ok _ -> Lwt.return ()
              | Error err -> Lwt.fail (Jump err))
           lst >>= fun () -> Lwt.return (Ok ()))
      (function Jump err -> Lwt.return (Error (`StoreRef err))
              | exn -> Lwt.fail exn) (* XXX(dinosaure): should never happen. *)

  let fetch_one t ?locks ~reference repository =
    let open Lwt.Infix in

    Negociator.find_common t >>= fun (has, state, continue) ->
    let continue { Client.Decoder.acks; shallow; unshallow } state =
      continue { Git.Negociator.acks; shallow; unshallow } state
    in
{'fraction_non_alphanumeric': 0.11594403657016207, 'fraction_numerical': 0.0019393267765618507, 'mean_word_length': 2.4218009478672986, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 74, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2865296', 'n_tokens_mistral': 2500, 'n_tokens_neox': 2422, 'n_words': 726}