Source file hashes.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
(**************************************************************************)
(*                                                                        *)
(*    Copyright 2020 OCamlPro & Origin Labs                               *)
(*                                                                        *)
(*  All rights reserved. This file is distributed under the terms of the  *)
(*  GNU Lesser General Public License version 2.1, with the special       *)
(*  exception on linking described in the file LICENSE.                   *)
(*                                                                        *)
(**************************************************************************)

open EzCompat

(* Management of .drom file of hashes *)

type t =
  { mutable hashes : string StringMap.t;
    mutable modified : bool;
    mutable files : (bool * string * string) list;
    (* for git *)
    mutable to_add : StringSet.t;
    mutable to_remove : StringSet.t
  }

let load () =
  let hashes =
    if Sys.file_exists ".drom" then (
      let map = ref StringMap.empty in
      (* Printf.eprintf "Loading .drom\n%!"; *)
      Array.iteri
        (fun i line ->
           try
             if line <> "" && line.[0] <> '#' then
               let digest, filename =
                 if String.contains line ':' then
                   EzString.cut_at line ':'
                 else
                   EzString.cut_at line ' '
                   (* only for backward compat *)
               in
               let digest = Digest.from_hex digest in
               map := StringMap.add filename digest !map
           with exn ->
             Printf.eprintf "Error loading .drom at line %d: %s\n%!"
               (i+1) (Printexc.to_string exn);
             Printf.eprintf " on line: %s\n%!" line;
             exit 2
        )
        (EzFile.read_lines ".drom");
      !map
    ) else
      StringMap.empty
  in
  { hashes;
    files = [];
    modified = false;
    to_add = StringSet.empty;
    to_remove = StringSet.empty
  }

let write t ~record file content =
  t.files <- (record, file, content) :: t.files;
  t.modified <- true

let get t file = StringMap.find file t.hashes

let update ?(git = true) t file hash =
  t.hashes <- StringMap.add file hash t.hashes;
  if git then t.to_add <- StringSet.add file t.to_add;
  t.modified <- true

let remove t file =
  t.hashes <- StringMap.remove file t.hashes;
  t.to_remove <- StringSet.add file t.to_remove;
  t.modified <- true

let rename t src_file dst_file =
  match get t src_file with
  | exception Not_found -> ()
  | digest ->
    remove t src_file;
    update t dst_file digest

let digest_file file = Digest.file file

let digest_string content = Digest.string content

let save ?(git = true) t =
  if t.modified then begin
    List.iter
      (fun (record, file, content) ->
        let dirname = Filename.dirname file in
        if not (Sys.file_exists dirname) then EzFile.make_dir ~p:true dirname;
        EzFile.write_file file content;
        if record then update t file (digest_string content))
      t.files;

    let b = Buffer.create 1000 in
    Printf.bprintf b
      "# Keep this file in your GIT repo to help drom track generated files\n";
    StringMap.iter
      (fun filename hash ->
        if Sys.file_exists filename then begin
          if filename = "." then begin
            Printf.bprintf b "\n# hash of toml configuration files\n";
            Printf.bprintf b "# used for generation of all files\n"
          end else begin
            Printf.bprintf b "\n# begin context for %s\n" filename;
            Printf.bprintf b "# file %s\n" filename
          end;
          Printf.bprintf b "%s:%s\n" (Digest.to_hex hash) filename;
          Printf.bprintf b "# end context for %s\n" filename
        end)
      t.hashes;
    EzFile.write_file ".drom" (Buffer.contents b);

    if git && Sys.file_exists ".git" then (
      let to_remove = ref [] in
      StringSet.iter
        (fun file ->
          if not (Sys.file_exists file) then to_remove := file :: !to_remove)
        t.to_remove;
      if !to_remove <> [] then Git.run ("rm" :: "-f" :: !to_remove);

      let to_add = ref [] in
      StringSet.iter
        (fun file -> if Sys.file_exists file then to_add := file :: !to_add)
        t.to_add;
      Git.run ("add" :: ".drom" :: !to_add)
    );
    t.to_add <- StringSet.empty;
    t.to_remove <- StringSet.empty;
    t.modified <- false
  end

let with_ctxt ?git f =
  let t = load () in
  match f t with
  | res ->
    save ?git t;
    res
  | exception exn ->
    let bt = Printexc.get_raw_backtrace () in
    save t;
    Printexc.raise_with_backtrace exn bt