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
type entry = {
hashed_content : string
; dynamic_dependencies : Deps.t
; last_build_date : int option
}
type t = entry Path.Map.t
let entry ?last_build_date hashed_content dynamic_dependencies =
{ hashed_content; dynamic_dependencies; last_build_date }
let empty = Path.Map.empty
let from_list = Path.Map.of_list
let update cache path ?(deps = Deps.empty) ~now content =
let entry = entry ~last_build_date:now content deps in
Path.Map.add path entry cache
let get cache path =
Option.map
(fun { hashed_content; dynamic_dependencies; last_build_date } ->
(hashed_content, dynamic_dependencies, last_build_date))
(Path.Map.find_opt path cache)
let entry_to_sexp { hashed_content; dynamic_dependencies; last_build_date } =
let open Sexp in
let last_build_date =
last_build_date
|> Option.map (fun x -> x |> string_of_int |> atom)
|> Option.to_list
in
node
([ atom hashed_content; Deps.to_sexp dynamic_dependencies ]
@ last_build_date)
let last_build_date_from_string lbd =
match int_of_string_opt lbd with
| None -> Error (Sexp.Invalid_sexp (Sexp.Atom lbd, "last_build_date"))
| Some x -> Ok x
let entry_from_sexp sexp =
let make hashed_content potential_deps last_build_date =
let entry = entry ?last_build_date hashed_content in
potential_deps
|> Deps.from_sexp
|> Result.map_error (fun _ -> Sexp.Invalid_sexp (sexp, "cache"))
|> Result.map entry
in
match sexp with
| Sexp.(Node [ Atom hashed_content; potential_deps ]) ->
make hashed_content potential_deps None
| Sexp.(Node [ Atom hashed_content; potential_deps; Atom last_build_date ]) ->
Result.bind (last_build_date_from_string last_build_date) (fun lbd ->
make hashed_content potential_deps (Some lbd))
| _ -> Error (Sexp.Invalid_sexp (sexp, "cache"))
let to_sexp cache =
Path.Map.fold
(fun key entry acc ->
let k = Path.to_sexp key in
let v = entry_to_sexp entry in
Sexp.node [ k; v ] :: acc)
cache []
|> Sexp.node
let key_value_from_sexp sexp =
match sexp with
| Sexp.(Node [ key; value ]) ->
Result.bind (Path.from_sexp key) (fun key ->
value |> entry_from_sexp |> Result.map (fun value -> (key, value)))
|> Result.map_error (fun _ -> Sexp.Invalid_sexp (sexp, "cache"))
| _ -> Error (Sexp.Invalid_sexp (sexp, "cache"))
let from_sexp sexp =
match sexp with
| Sexp.(Node entries) ->
List.fold_left
(fun acc line ->
Result.bind acc (fun acc ->
line |> key_value_from_sexp |> Result.map (fun x -> x :: acc)))
(Ok []) entries
|> Result.map Path.Map.of_list
| _ -> Error (Sexp.Invalid_sexp (sexp, "cache"))
let entry_equal
{
hashed_content = hashed_a
; dynamic_dependencies = deps_a
; last_build_date = lbd_a
}
{
hashed_content = hashed_b
; dynamic_dependencies = deps_b
; last_build_date = lbd_b
} =
String.equal hashed_a hashed_b
&& Deps.equal deps_a deps_b
&& Option.equal Int.equal lbd_a lbd_b
let equal = Path.Map.equal entry_equal
let pp_kv ppf (key, { hashed_content; dynamic_dependencies; last_build_date }) =
Format.fprintf ppf "%a => deps: @[<v 0>%a@]@hash:%s (%a)" Path.pp key Deps.pp
dynamic_dependencies hashed_content
(Format.pp_print_option Format.pp_print_int)
last_build_date
let pp ppf cache =
Format.fprintf ppf "Cache [@[<v 0>%a@]]"
(Format.pp_print_list
~pp_sep:(fun ppf () -> Format.fprintf ppf ";@ ")
pp_kv)
(Path.Map.to_list cache)