My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** Cache entry flags management *)
2
3type flag = [
4 | `Pinned
5 | `Stale
6 | `Temporary
7 | `Chunk
8]
9
10module FlagSet = Set.Make(struct
11 type t = flag
12 let compare = Stdlib.compare
13end)
14
15type t = FlagSet.t
16
17let empty = FlagSet.empty
18
19let of_list flags =
20 List.fold_left (fun acc f -> FlagSet.add f acc) FlagSet.empty flags
21
22let to_list t =
23 FlagSet.elements t
24
25let singleton flag =
26 FlagSet.singleton flag
27
28let add flag t =
29 FlagSet.add flag t
30
31let remove flag t =
32 FlagSet.remove flag t
33
34let mem flag t =
35 FlagSet.mem flag t
36
37let union = FlagSet.union
38
39let inter = FlagSet.inter
40
41let diff = FlagSet.diff
42
43let is_empty = FlagSet.is_empty
44
45let is_pinned t = mem `Pinned t
46
47let is_stale t = mem `Stale t
48
49let is_temporary t = mem `Temporary t
50
51let is_chunk t = mem `Chunk t
52
53let is_complete t = not (is_chunk t)
54
55let flag_to_char = function
56 | `Pinned -> 'P'
57 | `Stale -> 'S'
58 | `Temporary -> 'T'
59 | `Chunk -> 'C'
60
61let char_to_flag = function
62 | 'P' -> Some `Pinned
63 | 'S' -> Some `Stale
64 | 'T' -> Some `Temporary
65 | 'C' -> Some `Chunk
66 | _ -> None
67
68let to_string t =
69 to_list t
70 |> List.map flag_to_char
71 |> List.to_seq
72 |> String.of_seq
73
74let of_string s =
75 String.to_seq s
76 |> Seq.filter_map char_to_flag
77 |> List.of_seq
78 |> of_list
79
80let equal = FlagSet.equal
81
82let compare = FlagSet.compare
83
84let pp_flag fmt = function
85 | `Pinned -> Format.fprintf fmt "Pinned"
86 | `Stale -> Format.fprintf fmt "Stale"
87 | `Temporary -> Format.fprintf fmt "Temporary"
88 | `Chunk -> Format.fprintf fmt "Chunk"
89
90let pp fmt t =
91 let flags = to_list t in
92 match flags with
93 | [] -> Format.fprintf fmt "[]"
94 | _ ->
95 Format.fprintf fmt "[%s]"
96 (String.concat "," (List.map (function
97 | `Pinned -> "P"
98 | `Stale -> "S"
99 | `Temporary -> "T"
100 | `Chunk -> "C") flags))
101
102(* Jsont support *)
103
104(* JSON codec for individual flags - using string representation *)
105let flag_jsont =
106 let kind = "Flag" in
107 let doc = "A cache entry flag" in
108 let dec s =
109 match s with
110 | "pinned" -> `Pinned
111 | "stale" -> `Stale
112 | "temporary" -> `Temporary
113 | "chunk" -> `Chunk
114 | _ -> Jsont.Error.msg Jsont.Meta.none "Invalid flag value"
115 in
116 let enc = function
117 | `Pinned -> "pinned"
118 | `Stale -> "stale"
119 | `Temporary -> "temporary"
120 | `Chunk -> "chunk"
121 in
122 Jsont.map ~kind ~doc ~dec ~enc Jsont.string
123
124(* JSON codec for flag set *)
125let jsont =
126 let kind = "Flags" in
127 let doc = "A set of cache entry flags" in
128 let dec lst = of_list lst in
129 let enc t = to_list t in
130 Jsont.map ~kind ~doc ~dec ~enc (Jsont.list flag_jsont)