<commit_before>(**************************************************************************)
(*  Copyright 2014, <NAME> <<EMAIL>>                     *)
(*                                                                        *)
(*  Licensed under the Apache License, Version 2.0 (the "License");       *)
(*  you may not use this file except in compliance with the License.      *)
(*  You may obtain a copy of the License at                               *)
(*                                                                        *)
(*      http://www.apache.org/licenses/LICENSE-2.0                        *)
(*                                                                        *)
(*  Unless required by applicable law or agreed to in writing, software   *)
(*  distributed under the License is distributed on an "AS IS" BASIS,     *)
(*  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or       *)
(*  implied.  See the License for the specific language governing         *)
(*  permissions and limitations under the License.                        *)
(**************************************************************************)

open Ketrew_pervasives

let global_debug_level = ref 4
let local_verbosity () = `Debug !global_debug_level

type action =
  | Set of string * string
  | Unset of string
  | Sequence of action list
  | Check of string * string option
let set ~key value = Set (key, value)
let seq l = Sequence l
let contains ~key v = Check (key, Some v) 
let is_not_set key = Check (key, None)
let unset key = Unset key

let rec log_action =
  let open Log in
  function
  | Set (k, v) -> brakets(s "Set " % s k % sp % s v)
  | Check (k, vo) -> brakets(s "Check " % s k % sp % OCaml.option s vo)
  | Unset k -> brakets(s "Uet " % s k)
  | Sequence l -> OCaml.list log_action l

type error =
  [ `Act of action | `Get of string | `Load of string | `Close ] * string

let log_error = function
| `Database (what, msg) ->
  Log.(s "Database" % sp
       % parens (match what with
         | `Load path -> s "Loading " % s path
         | `Get k -> s "Getting " % s k
         | `Act a -> s "Processing " % log_action a
         | `Close -> s "Closing")
       % s " → "
       % s msg)

(* type stupid_db = Ketrew_gen_base_v0_t.stupid_db *)
type t = {
  (* mutable db: Dbm.t; *)
  (* mutable history: (action * stupid_db) list; *)
  path: string;
  mutex: Lwt_mutex.t;
  exec_style: [`Shell | `Exec];
}
let create path = {exec_style = `Shell; mutex = Lwt_mutex.create (); path} 

module Debug = struct

  type t =  No | After_write of string 
         | After_git_add of string  | After_git_rm of string 
  let global_debug = ref No

  exception E
  let after_write k =
    match !global_debug with
    | After_write s when s = k ->
      Log.(s "Throwing Debug exn: After_write" % sp % s k @ warning);
      raise E
    | _ -> ()

  let after_git_add k  =
    match !global_debug with
    | After_git_add s when s = k ->
      Log.(s "Throwing Debug exn: After_git_add" % sp % s k @ warning);
      raise E
    | _ -> ()

  let after_git_rm k  =
    match !global_debug with
    | After_git_rm s when s = k ->
      Log.(s "Throwing Debug exn: After_git_rm" % sp % s k @ warning);
      raise E
    | _ -> ()

end

let db_process_shell ~loc cmd =
  System.Shell.do_or_fail (String.concat ~sep:" " (List.map cmd ~f:Filename.quote))
  >>< function
  | `Ok () -> return ()
  | `Error e ->
    Log.(s "Database-command failure (Shell):"
         % sp % OCaml.(list string cmd) @ very_verbose);
    fail (`Database (loc, System.error_to_string e))

let db_process_exec ~loc cmd =
  Ketrew_unix_process.succeed cmd
  >>< function
  | `Ok (_, _) -> return ()
  | `Error e ->
    Log.(s "Database-command failure (exec):"
         % sp % OCaml.(list string cmd) @ very_verbose);
    fail (`Database (loc, Ketrew_unix_process.error_to_string e))

let call_git ~loc t cmd =
  let actualexec = [
    "git"; "--git-dir"; Filename.concat t.path ".git"; "--work-tree"; t.path;
  ] @ cmd in
      match t.exec_style with
      | `Shell -> db_process_shell ~loc actualexec
      | `Exec -> db_process_exec ~loc actualexec

let load init_path =
  let path = 
    if Filename.is_relative init_path
    then Filename.concat (Sys.getcwd ()) init_path
    else init_path in
  let creation_witness =  (Filename.concat path "_ketrew_database_init") in
  begin
    System.file_info ~follow_symlink:true creation_witness
    >>= fun file_info ->
    begin match file_info with
    | `Regular_file _ -> 
      let t = create path in
      call_git  ~loc:(`Load path)  t ["checkout"; "master"]
      >>= fun () ->
      return t
    | `Absent ->
      System.ensure_directory_path ~perm:0o700 path
      >>= fun () ->
      let t = create path in
      call_git  ~loc:(`Load path)  t ["init"] >>= fun () ->
      call_git  ~loc:(`Load path) t
        ["config"; "user.email"; "<EMAIL>"]
      >>= fun () ->
      call_git  ~loc:(`Load path) t
        ["config"; "user.name"; "Ketrew"]
      >>= fun () ->
      IO.write_file creation_witness ~content:"OK"
      >>= fun () ->
      call_git  ~loc:(`Load path)  t ["add"; creation_witness]
      >>= fun () ->
      call_git  ~loc:(`Load path)  t ["commit"; "-m"; "Initialize database"]
      >>= fun () ->
      return t
    | other ->
      fail (`Database (`Load path, fmt "%S not a file: %s" path 
                         (System.file_info_to_string other)))
    end
  end >>< function
  | `Ok o -> return o
  | `Error e ->
    begin match e with
    | `Database _ as e -> fail e
    | `IO _ as e -> fail (`Database (`Load path, IO.error_to_string e))
    | `System _ as e -> fail (`Database (`Load path, System.error_to_string e))
    end

let close t =
  return ()

let path_of_key t key =
  let sanitize k  = 
    String.map k ~f:(function
      | '/' -> '_') in
  Filename.concat t.path (sanitize key)

let get_no_mutex t ~key =
  IO.read_file (path_of_key t key)
  >>< function
  | `Ok o -> return (Some o)
  | `Error (`IO (`Read_file_exn (s, e))) ->
    return None<commit_msg>lib: fix stupid bug (missing match case)<commit_after>(**************************************************************************)
(*  Copyright 2014, <NAME> <<EMAIL>>                     *)
(*                                                                        *)
(*  Licensed under the Apache License, Version 2.0 (the "License");       *)
(*  you may not use this file except in compliance with the License.      *)
(*  You may obtain a copy of the License at                               *)
(*                                                                        *)
(*      http://www.apache.org/licenses/LICENSE-2.0                        *)
(*                                                                        *)
(*  Unless required by applicable law or agreed to in writing, software   *)
(*  distributed under the License is distributed on an "AS IS" BASIS,     *)
(*  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or       *)
(*  implied.  See the License for the specific language governing         *)
(*  permissions and limitations under the License.                        *)
(**************************************************************************)

open Ketrew_pervasives

let global_debug_level = ref 4
let local_verbosity () = `Debug !global_debug_level

type action =
  | Set of string * string
  | Unset of string
  | Sequence of action list
  | Check of string * string option
let set ~key value = Set (key, value)
let seq l = Sequence l
let contains ~key v = Check (key, Some v) 
let is_not_set key = Check (key, None)
let unset key = Unset key

let rec log_action =
  let open Log in
  function
  | Set (k, v) -> brakets(s "Set " % s k % sp % s v)
  | Check (k, vo) -> brakets(s "Check " % s k % sp % OCaml.option s vo)
  | Unset k -> brakets(s "Uet " % s k)
  | Sequence l -> OCaml.list log_action l

type error =
  [ `Act of action | `Get of string | `Load of string | `Close ] * string

let log_error = function
| `Database (what, msg) ->
  Log.(s "Database" % sp
       % parens (match what with
         | `Load path -> s "Loading " % s path
         | `Get k -> s "Getting " % s k
         | `Act a -> s "Processing " % log_action a
         | `Close -> s "Closing")
       % s " → "
       % s msg)

(* type stupid_db = Ketrew_gen_base_v0_t.stupid_db *)
type t = {
  (* mutable db: Dbm.t; *)
  (* mutable history: (action * stupid_db) list; *)
  path: string;
  mutex: Lwt_mutex.t;
  exec_style: [`Shell | `Exec];
}
let create path = {exec_style = `Shell; mutex = Lwt_mutex.create (); path} 

module Debug = struct

  type t =  No | After_write of string 
         | After_git_add of string  | After_git_rm of string 
  let global_debug = ref No

  exception E
  let after_write k =
    match !global_debug with
    | After_write s when s = k ->
      Log.(s "Throwing Debug exn: After_write" % sp % s k @ warning);
      raise E
    | _ -> ()

  let after_git_add k  =
    match !global_debug with
    | After_git_add s when s = k ->
      Log.(s "Throwing Debug exn: After_git_add" % sp % s k @ warning);
      raise E
    | _ -> ()

  let after_git_rm k  =
    match !global_debug with
    | After_git_rm s when s = k ->
      Log.(s "Throwing Debug exn: After_git_rm" % sp % s k @ warning);
      raise E
    | _ -> ()

end

let db_process_shell ~loc cmd =
  System.Shell.do_or_fail (String.concat ~sep:" " (List.map cmd ~f:Filename.quote))
  >>< function
  | `Ok () -> return ()
  | `Error e ->
    Log.(s "Database-command failure (Shell):"
         % sp % OCaml.(list string cmd) @ very_verbose);
    fail (`Database (loc, System.error_to_string e))

let db_process_exec ~loc cmd =
  Ketrew_unix_process.succeed cmd
  >>< function
  | `Ok (_, _) -> return ()
  | `Error e ->
    Log.(s "Database-command failure (exec):"
         % sp % OCaml.(list string cmd) @ very_verbose);
    fail (`Database (loc, Ketrew_unix_process.error_to_string e))

let call_git ~loc t cmd =
  let actualexec = [
    "git"; "--git-dir"; Filename.concat t.path ".git"; "--work-tree"; t.path;
  ] @ cmd in
      match t.exec_style with
      | `Shell -> db_process_shell ~loc actualexec
      | `Exec -> db_process_exec ~loc actualexec

let load init_path =
  let path = 
    if Filename.is_relative init_path
    then Filename.concat (Sys.getcwd ()) init_path
    else init_path in
  let creation_witness =  (Filename.concat path "_ketrew_database_init") in
  begin
    System.file_info ~follow_symlink:true creation_witness
    >>= fun file_info ->
    begin match file_info with
    | `Regular_file _ -> 
      let t = create path in
      call_git  ~loc:(`Load path)  t ["checkout"; "master"]
      >>= fun () ->
      return t
    | `Absent ->
      System.ensure_directory_path ~perm:0o700 path
      >>= fun () ->
      let t = create path in
      call_git  ~loc:(`Load path)  t ["init"] >>= fun () ->
      call_git  ~loc:(`Load path) t
        ["config"; "user.email"; "<EMAIL>"]
      >>= fun () ->
      call_git  ~loc:(`Load path) t
        ["config"; "user.name"; "Ketrew"]
      >>= fun () ->
      IO.write_file creation_witness ~content:"OK"
      >>= fun () ->
      call_git  ~loc:(`Load path)  t ["add"; creation_witness]
      >>= fun () ->
      call_git  ~loc:(`Load path)  t ["commit"; "-m"; "Initialize database"]
      >>= fun () ->
      return t
    | other ->
      fail (`Database (`Load path, fmt "%S not a file: %s" path 
                         (System.file_info_to_string other)))
    end
  end >>< function
  | `Ok o -> return o
  | `Error e ->
    begin match e with
    | `Database _ as e -> fail e
    | `IO _ as e -> fail (`Database (`Load path, IO.error_to_string e))
    | `System _ as e -> fail (`Database (`Load path, System.error_to_string e))
    end

let close t =
  return ()

let path_of_key t key =
  let sanitize k  = 
    String.map k ~f:(function
      | '/' -> '_'
      | e -> e
      ) in
  Filename.concat t.path (sanitize key)

let get_no_mutex t ~key =
  IO.read_file (path_of_key t key)
  >>< function
  | `Ok o -> return (Some o)
  | `Error (`IO (`Read_file_exn (s, e))) ->
    return None
{'fraction_non_alphanumeric': 0.1496497733827771, 'fraction_numerical': 0.0023073753605274, 'mean_word_length': 2.1861380939879234, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 146, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 20, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3278484', 'n_tokens_mistral': 3909, 'n_tokens_neox': 3801, 'n_words': 1249}