<commit_before>(*
 * Copyright (c) 2013-2014 <NAME> <<EMAIL>>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Core_kernel.Std
open Lwt

let to_string node =
  let hex = SHA1.to_hex node in
  String.sub hex 0 8

module C =
  Graph.Imperative.Digraph.ConcreteBidirectionalLabeled
    (struct
      type t = (SHA1.t * Value.t)
      let compare (x,_) (y,_) = String.compare (SHA1.to_string x) (SHA1.to_string y)
      let hash (x,_) = Hashtbl.hash (SHA1.to_string x)
      let equal (x,_) (y,_) = (x = y)
    end)
    (struct
      type t = string
      let default = ""
      let compare = String.compare
    end)

module Dot = Graph.Graphviz.Dot(struct
    include C
    let graph_attributes _ = []
    let default_vertex_attributes _ = []
    let vertex_name (x,o) =
      let hex = to_string x in
      let p = match o with
        | Value.Blob _   -> "B"
        | Value.Commit _ -> "C"
        | Value.Tree _   -> "Tr"
        | Value.Tag  _   -> "Ta" in
      Printf.sprintf "\"%s-%s\"" p hex
    let vertex_attributes (_,o) =
      match o with
      | Value.Commit _ -> [`Shape `Doublecircle]
      | _ -> []
    let get_subgraph _ = None
    let default_edge_attributes _ = []
    let edge_attributes (_,l,_) =
      match l with
      | "" -> []
      | _  ->[`Label l]
  end)

module K = Graph.Imperative.Digraph.ConcreteBidirectional(SHA1)
module KO = Graph.Oper.I(K)

module Make (Store: Store.S) = struct

  module Log = Log.Make(struct let section = "graph" end)

  module Search = struct
    include Search.Make(Store)
    include Search
  end

  let of_contents t =
    Log.debugf "of_contents";
    let g = C.create () in
    Store.contents t >>= fun nodes ->
    List.iter ~f:(C.add_vertex g) nodes;
    begin
      Misc.list_iter_p (fun (id, _ as src) ->
          Search.succ t id >>= fun succs ->
          Misc.list_iter_p (fun s ->
              let l = match s with
                | `Commit _   -> ""
                | `Tag (t,_)  -> "TAG-" ^ t
                | `Tree (f,_) -> f in
              let sha1 = Search.sha1_of_succ s in
              Store.read_exn t sha1 >>= fun v ->
              C.add_edge_e g (src, l, (sha1, v));
              return_unit<commit_msg>Fix the generation of .dot files<commit_after>(*
 * Copyright (c) 2013-2014 <NAME> <<EMAIL>>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Core_kernel.Std
open Lwt

let to_string node =
  let hex = SHA1.to_hex node in
  String.sub hex 0 8

module C =
  Graph.Imperative.Digraph.ConcreteBidirectionalLabeled
    (struct
      type t = (SHA1.t * Value.t)
      let compare (x,_) (y,_) = String.compare (SHA1.to_string x) (SHA1.to_string y)
      let hash (x,_) = Hashtbl.hash (SHA1.to_string x)
      let equal (x,_) (y,_) = (x = y)
    end)
    (struct
      type t = string
      let default = ""
      let compare = String.compare
    end)

module Dot = Graph.Graphviz.Dot(struct
    include C
    let graph_attributes _ = []
    let default_vertex_attributes _ = []
    let vertex_name (x,o) =
      let hex = to_string x in
      let p = match o with
        | Value.Blob _   -> "B"
        | Value.Commit _ -> "C"
        | Value.Tree _   -> "Tr"
        | Value.Tag  _   -> "Ta" in
      Printf.sprintf "\"%s-%s\"" p hex
    let vertex_attributes (_,o) =
      match o with
      | Value.Commit _ -> [`Shape `Doublecircle]
      | _ -> []
    let get_subgraph _ = None
    let default_edge_attributes _ = []
    let edge_attributes (_,l,_) =
      match l with
      | "" -> []
      | _  ->[`Label (String.escaped l)]
  end)

module K = Graph.Imperative.Digraph.ConcreteBidirectional(SHA1)
module KO = Graph.Oper.I(K)

module Make (Store: Store.S) = struct

  module Log = Log.Make(struct let section = "graph" end)

  module Search = struct
    include Search.Make(Store)
    include Search
  end

  let of_contents t =
    Log.debugf "of_contents";
    let g = C.create () in
    Store.contents t >>= fun nodes ->
    List.iter ~f:(C.add_vertex g) nodes;
    begin
      Misc.list_iter_p (fun (id, _ as src) ->
          Search.succ t id >>= fun succs ->
          Misc.list_iter_p (fun s ->
              let l = match s with
                | `Commit _   -> ""
                | `Tag (t,_)  -> "TAG-" ^ t
                | `Tree (f,_) -> f in
              let sha1 = Search.sha1_of_succ s in
              Store.read_exn t sha1 >>= fun v ->
              C.add_edge_e g (src, l, (sha1, v));
              return_unit
{'fraction_non_alphanumeric': 0.10406616126809097, 'fraction_numerical': 0.006891798759476223, 'mean_word_length': 2.2852292020373515, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 53, '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': '4510851', 'n_tokens_mistral': 1915, 'n_tokens_neox': 1831, 'n_words': 643}